DataMuseum.dk

Presents historical artifacts from the history of:

ICL Comet

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about ICL Comet

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦c69e87ce6⟧ TextFile

    Length: 16128 (0x3f00)
    Types: TextFile
    Names: »COMGRAPH.CML«

Derivation

└─⟦0bea7a4e4⟧ Bits:30004201 COMET GRAFIK for MPS-24 tilpasset COMAL-80 Ver. 2.02a
    └─ ⟦this⟧ »COMGRAPH.CML« 

TextFile

9000 // Proceduregruppe COMGRAPH           SEP.84 / ULJ            Version 2.1
9001 //
9002 // ######################################################################
9003 // ##  Copyright (C) ICL A/S november l982, september 1984.            ##
9004 // ##  Dette programmel stilles af ICL A/S til brugernes  rådighed  i  ##
9005 // ##  forbindelse med levering af grafikprocessor MPS-24 til COMET.   ##
9006 // ##  Programmellet må anvendes i forbindelse med den leverede  gra-  ##
9007 // ##  fikprocessor. Det er tilladt at foretage sikkerhedskopiering i  ##
9008 // ##  fornødent omfang samt at anvende  programmellet  i  programmer  ##
9009 // ##  til eget brug.                                                  ##
9010 // ##  Enhver anden form for anvendelse af  programellet  -  herunder  ##
9011 // ##  kommerciel udnyttelse af dette samt distribution  til  tredie-  ##
9012 // ##  part - er ikke tilladt.                                         ##
9013 // ##  ICL A/S påtager sig ingen forpligtigelser med hensyn til fejl-  ##
9014 // ##  rettelser og/eller videreudvikling/opdatering af det  leverede  ##
9015 // ##  programmel.                                                     ##
9016 // ##  Ophavsretten til programmel samt tilhørende dokumentation for-  ##
9017 // ##  bliver hos ICL A/S.                                             ##
9018 // ######################################################################
9019 //
9020 // ***** GRUPPE 1 ***** Diverse initieringer **************************
9021 //
9022 PROC INITGRAFIK(SKRMNR) //
9023   OUT 176, 255
9024   OUT 179, 255*(SKRMNR-1)
9025   OUT 160, 7
9026   OUT 161, 11
9027 ENDPROC INITGRAFIK
9028 //
9029 PROC GRAFIK(SKRMNR) //
9030   OUT 176, 255
9031   OUT 179, 255*(SKRMNR-1)
9032 ENDPROC GRAFIK
9033 //
9034 PROC VIDEO //
9035   OUT 176, 0
9036 ENDPROC VIDEO
9037 //
9038 PROC TIME(SEC) //
9039   FOR TID:=1 TO 800*SEC DO 
9040   NEXT TID
9041 ENDPROC TIME
9042 //
9043 PROC WAIT(REF KAR) //
9044   POKE 256, 195
9045   TRAP ESC-
9046   REPEAT 
9047     IF ESC() THEN 
9048       KAR:=27
9049     ELSE 
9050       KAR:=PEEK(256)
9051     ENDIF 
9052   UNTIL KAR<>195
9053   TRAP ESC+
9054 ENDPROC WAIT
9055 //
9056 PROC INITSTATUS //
9057   STATUS:=0
9058   EXEC STATUSINIT
9059 ENDPROC INITSTATUS
9060 //
9061 PROC STATUSINIT CLOSED
9062   IMPORT STATUS
9063   DIM STATUS$ OF 10
9064   STATUS:=VARPTR(STATUS$)+2
9065   POKE STATUS, 219 // IN  160
9066   POKE STATUS+1, 160 // COMMANDOREGISTER
9067   POKE STATUS+2, 230 // ANI 00000100B
9068   POKE STATUS+3, 4
9069   POKE STATUS+4, 254 // CPI 0
9070   POKE STATUS+5, 0
9071   POKE STATUS+6, 202 // JZ  STATUS
9072   POKE STATUS+7, STATUS MOD 256
9073   POKE STATUS+8, STATUS DIV 256
9074   POKE STATUS+9, 201 // RETURN
9075 ENDPROC STATUSINIT
9076 //
9100 // ***** GRUPPE 2 ***** Tegning af figurer og tekst. ********************
9101 //
9102 PROC DISPLINEALL(TY, BR, X1, Y1, X2, Y2)
9103   OUT 162, TY+(INP(162) DIV 4)*4
9104   IF X1=X2 THEN 
9105     FOR STRBR:=X1-INT(BR/2) TO X1+INT(BR/2) DO 
9106       EXEC DISPLINE(STRBR,Y1,STRBR,Y2)
9107     NEXT STRBR
9108   ELIF Y1=Y2 THEN 
9109     FOR STRBR:=Y1-INT(BR/2) TO Y1+INT(BR/2) DO 
9110       EXEC DISPLINE(X1,STRBR,X2,STRBR)
9111     NEXT STRBR
9112   ELSE 
9113     FOR STRBR:=-INT(BR/2) TO INT(BR/2) DO 
9114       EXEC DISPLINE(X1,Y1+STRBR,X2,Y2+STRBR)
9115     NEXT STRBR
9116   ENDIF 
9117 ENDPROC DISPLINEALL
9118 //
9119 PROC DISPREKTALL(TY, BR, X1, Y1, X2, Y2)
9120   OUT 162, TY+(INP(162) DIV 4)*4
9121   FOR RBR:=-INT(BR/2) TO INT(BR/2) DO 
9122     EXEC DISPREKT(X1-RBR,Y1-RBR,X2+RBR,Y2+RBR)
9123   NEXT RBR
9124 ENDPROC DISPREKTALL
9125 //
9126 PROC DISPCIRKELALL(TY, BR, X1, Y1, X2, Y2)
9127   OUT 162, TY+(INP(162) DIV 4)*4
9128   XX2:=SQR((X1-X2)^2+(Y1-Y2)^2)+X1
9129   FOR CI:=-INT(BR/2) TO INT(BR/2) DO 
9130     EXEC DISPCIRKEL(X1,Y1,XX2+CI,Y1)
9131   NEXT CI
9132 ENDPROC DISPCIRKELALL
9133 //
9134 PROC DISPCHRALL(TY, MX, MY, X1, Y1, S$)
9135   OUT 162, TY*4+(INP(162) MOD 4)
9136   IF MX=16 THEN MX:=0
9137   IF MY=16 THEN MY:=0
9138   OUT 163, MX*16+MY
9139   EXEC DISPCHR(X1,Y1,S$)
9140 ENDPROC DISPCHRALL
9141 //
9142 PROC DISPCHRALLDK(TY, MX, MY, X1, Y1, S$)
9143   OUT 162, TY*4+(INP(162) MOD 4)
9144   IF MX=16 THEN MX:=0
9145   IF MY=16 THEN MY:=0
9146   OUT 163, MX*16+MY
9147   EXEC DISPCHRDK(X1,Y1,S$)
9148 ENDPROC DISPCHRALLDK
9149 //
9150 PROC FILL(X1, Y1, X2, Y2, PENERASE)
9151   IF X1>X2 THEN 
9152     PZ:=X1; X1:=X2; X2:=PZ
9153   ENDIF 
9154   IF Y1>Y2 THEN 
9155     PZ:=Y1; Y1:=Y2; Y2:=PZ
9156   ENDIF 
9157   IF X2-X1>255 THEN 
9158     EXEC FILL(X1,Y1,X2 DIV 2,Y2,PENERASE)
9159     X1:=(X2 DIV 2)+1
9160   ENDIF 
9161   OUT 165, X2-X1
9162   OUT 160, PENERASE
9163   FOR FII:=Y1 TO Y2 DO 
9164     OUT 168, X1 DIV 256
9165     OUT 169, X1 MOD 256
9166     OUT 170, FII DIV 256
9167     OUT 171, FII MOD 256
9168     OUT 160, 16
9169   NEXT FII
9170   OUT 160, 0
9171 ENDPROC FILL
9172 //
9200 // ***** GRUPPE 3 ***** tegning af figurer og tekst - enkelt streg ******
9201 //
9202 PROC DISPLINE(X1, Y1, X2, Y2)
9203   WHILE ABS(X2-X1)>255 OR ABS(Y2-Y1)>255 DO 
9204     XX2:=INT((X2-X1)/2)+X1; YY2:=INT((Y2-Y1)/2)+Y1
9205     EXEC DISPLINE(X1,Y1,XX2,YY2)
9206     X1:=XX2; Y1:=YY2
9207   ENDWHILE 
9208   OUT 168, X1 DIV 256
9209   OUT 169, X1 MOD 256
9210   OUT 170, Y1 DIV 256
9211   OUT 171, Y1 MOD 256
9212   OUT 165, ABS(X2-X1)
9213   OUT 167, ABS(Y2-Y1)
9214   OUT 160, 17+2*((X2-X1)<0)+4*((Y2-Y1)<0)
9215 ENDPROC DISPLINE
9216 //
9217 PROC DISPVEKTOR(PX, PY)
9218   PX1:=INP(168)*256+INP(169); PY1:=INP(170)*256+INP(171)
9219   WHILE ABS(PX1-PX)>255 OR ABS(PY1-PY)>255 DO 
9220     PXX1:=INT((PX-PX1)/2)+PX1; PYY1:=INT((PY-PY1)/2)+PY1
9221     EXEC DISPVEKTOR(PXX1,PYY1)
9222     PX1:=PXX1; PY1:=PYY1
9223   ENDWHILE 
9224   OUT 165, ABS(PX1-PX)
9225   OUT 167, ABS(PY1-PY)
9226   OUT 160, 17+2*((PX-PX1)<0)+4*((PY-PY1)<0)
9227 ENDPROC DISPVEKTOR
9228 //
9229 PROC DISPREKT(X1, Y1, X2, Y2)
9230   OUT 168, INT(X1) DIV 256
9231   OUT 169, INT(X1) MOD 256
9232   OUT 170, INT(Y1) DIV 256
9233   OUT 171, INT(Y1) MOD 256
9234   EXEC DISPVEKTOR(X2,Y1)
9235   EXEC DISPVEKTOR(X2,Y2)
9236   EXEC DISPVEKTOR(X1,Y2)
9237   EXEC DISPVEKTOR(X1,Y1)
9238 ENDPROC DISPREKT
9239 //
9240 PROC DISPCIRKEL(X1, Y1, X2, Y2)
9241   TOPI:=8*ATN(1)
9242   RADIUS:=SQR((X1-X2)^2+(Y1-Y2)^2)
9243   XX1:=X1+RADIUS; YY1:=Y1
9244   OUT 168, INT(XX1) DIV 256
9245   OUT 169, INT(XX1) MOD 256
9246   OUT 170, INT(YY1) DIV 256
9247   OUT 171, INT(YY1) MOD 256
9248   FOR GRAD:=0.05 TO TOPI STEP 0.05 DO 
9249     XX2:=INT((RADIUS)*COS(GRAD)+X1)
9250     YY2:=INT((RADIUS)*SIN(GRAD)+Y1)
9251     IF ABS(XX2-XX1)<4 AND ABS(YY2-YY1)<4 THEN 
9252       OUT 160, 129+ABS(XX2-XX1)*32+ABS(YY2-YY1)*8+((XX2-XX1)<0)*2+((YY2-YY1)<0)*4
9253     ELSE 
9254       OUT 165, ABS(XX2-XX1)
9255       OUT 167, ABS(YY2-YY1)
9256       OUT 160, 17+((XX2-XX1)<0)*2+((YY2-YY1)<0)*4
9257     ENDIF 
9258     XX1:=XX2; YY1:=YY2
9259   NEXT GRAD
9260   EXEC DISPLINE(XX1,YY1,X1+RADIUS,Y1)
9261 ENDPROC DISPCIRKEL
9262 //
9263 PROC DISPCHR(X1, Y1, S$)
9264   OUT 168, INT(X1) DIV 256
9265   OUT 169, INT(X1) MOD 256
9266   OUT 170, INT(Y1) DIV 256
9267   OUT 171, INT(Y1) MOD 256
9268   FOR DI:=1 TO LEN(S$) DO 
9269     OUT 160, ORD(S$(DI))
9270   NEXT DI
9271 ENDPROC DISPCHR
9272 //
9273 PROC DISPCHRDK(X1, Y1, S$)
9274   OUT 168, INT(X1) DIV 256
9275   OUT 169, INT(X1) MOD 256
9276   OUT 170, INT(Y1) DIV 256
9277   OUT 171, INT(Y1) MOD 256
9278   FOR DI:=1 TO LEN(S$) DO 
9279     IF S$(DI) IN "ÆØÅæøå" THEN 
9280       EXEC DANSK(S$(DI))
9281     ELSE 
9282       OUT 160, ORD(S$(DI))
9283     ENDIF 
9284   NEXT DI
9285 ENDPROC DISPCHRDK
9286 //
9300 // ***** GRUPPE 4 ***** Skrivning til registre **************************
9301 //
9302 PROC SETXY(X, Y)
9303   EXEC SETX(X)
9304   EXEC SETY(Y)
9305 ENDPROC SETXY
9306 //
9307 PROC SETX(X)
9308   OUT 168, INT(X) DIV 256
9309   OUT 169, INT(X) MOD 256
9310 ENDPROC SETX
9311 //
9312 PROC SETY(Y)
9313   OUT 170, INT(Y) DIV 256
9314   OUT 171, INT(Y) MOD 256
9315 ENDPROC SETY
9316 //
9317 PROC SETDELTAXY(DX, DY)
9318   OUT 165, INT(DX)
9319   OUT 167, INT(DY)
9320 ENDPROC SETDELTAXY
9321 //
9322 PROC SETDELTAX(DX)
9323   OUT 165, INT(DX)
9324 ENDPROC SETDELTAX
9325 //
9326 PROC SETDELTAY(DY)
9327   OUT 167, INT(DY)
9328 ENDPROC SETDELTAY
9329 //
9330 PROC SETCTRL2(V)
9331   OUT 162, INT(V)
9332 ENDPROC SETCTRL2
9333 //
9334 PROC SETLINETYPE(TY)
9335   OUT 162, TY+(INP(162) DIV 4)*4
9336 ENDPROC SETLINETYPE
9337 //
9338 PROC SETCHRTYPE(TY)
9339   OUT 162, TY*4+(INP(162) MOD 4)
9340 ENDPROC SETCHRTYPE
9341 //
9342 PROC SETCHRSIZEXY(MX, MY)
9343   IF MX=16 THEN MX:=0
9344   IF MY=16 THEN MY:=0
9345   OUT 163, MY+16*MX
9346 ENDPROC SETCHRSIZEXY
9347 //
9348 PROC SETCHRSIZEX(MX)
9349   IF MX=16 THEN MX:=0
9350   OUT 163, (INP(163) MOD 16)+MX*16
9351 ENDPROC SETCHRSIZEX
9352 //
9353 PROC SETCHRSIZEY(MY)
9354   IF MY=16 THEN MY:=0
9355   OUT 163, MY+(INP(163) DIV 16)*16
9356 ENDPROC SETCHRSIZEY
9357 //
9358 PROC SETCTRL1(V)
9359   OUT 161, V
9360 ENDPROC SETCTRL1
9361 //
9362 PROC SETPENSLETTE(F)
9363   OUT 160, NOT F
9364 ENDPROC SETPENSLETTE
9365 //
9366 PROC SETUPDOWN(F)
9367   OUT 160, 3-F
9368 ENDPROC SETUPDOWN
9369 //
9370 PROC SETSKÆRM(S)
9371   OUT 161, (INP(161) MOD 8)+S*8
9372 ENDPROC SETSKÆRM
9373 //
9374 PROC SETRMW(F)
9375   OUT 177, 255*F
9376 ENDPROC SETRMW
9377 //
9378 PROC CLEARSCREEN //
9379   OUT 160, 4
9380 ENDPROC CLEARSCREEN
9381 //
9382 PROC RESETXY //
9383   OUT 160, 5
9384 ENDPROC RESETXY
9385 //
9386 PROC RESETX //
9387   OUT 160, 13
9388 ENDPROC RESETX
9389 //
9390 PROC RESETY //
9391   OUT 160, 14
9392 ENDPROC RESETY
9393 //
9394 PROC RESETALL //
9395   OUT 160, 7
9396 ENDPROC RESETALL
9397 //
9398 PROC COMMANDO(C)
9399   OUT 160, C
9400   CALL STATUS
9401 ENDPROC COMMANDO
9402 //
9500 // ***** GRUPPE 5 ***** Indlæsning fra registre (procedurer) ************
9501 //
9502 PROC INPX(REF X1)
9503   X1:=INP(168)*256+INP(169)
9504 ENDPROC INPX
9505 //
9506 PROC INPY(REF Y1)
9507   Y1:=INP(170)*256+INP(171)
9508 ENDPROC INPY
9509 //
9510 PROC INPDELTAX(REF DX)
9511   DX:=INP(165)
9512 ENDPROC INPDELTAX
9513 //
9514 PROC INPDELTAY(REF DY)
9515   DY:=INP(167)
9516 ENDPROC INPDELTAY
9517 //
9518 PROC INPCTRL1(REF CTRL1)
9519   CTRL1:=INP(161)
9520 ENDPROC INPCTRL1
9521 //
9522 PROC INPCTRL2(REF CTRL2)
9523   CTRL2:=INP(162)
9524 ENDPROC INPCTRL2
9525 //
9526 PROC INPLINETYPE(REF TY)
9527   TY:=INP(162) MOD 4
9528 ENDPROC INPLINETYPE
9529 //
9530 PROC INPCHRTYPE(REF TY)
9531   TY:=INP(162) DIV 4
9532 ENDPROC INPCHRTYPE
9533 //
9534 PROC INPCHRSIZE(REF MX, REF MY)
9535   MX:=INP(163) DIV 32; MY:=INP(163) MOD 32
9536   IF MX=0 THEN MX:=16
9537   IF MY=0 THEN MY:=16
9538 ENDPROC INPCHRSIZE
9539 //
9540 PROC INPPENSLET(REF PEN)
9541   PEN:=(INP(161) MOD 4) DIV 2
9542 ENDPROC INPPENSLET
9543 //
9544 PROC INPUPDOWN(REF UPDOWN)
9545   UPDOWN:=INP(161) DIV 2
9546 ENDPROC INPUPDOWN
9547 //
9548 PROC INPSKÆRM(REF SKÆRM)
9549   SKÆRM:=(INP(161) MOD 16) DIV 8
9550 ENDPROC INPSKÆRM
9551 //
9552 PROC LÆSSKÆRMALL(X, Y, REF RES)
9553   EXEC SETXY(X,Y)
9554   EXEC LÆSSKÆRM(RES)
9555 ENDPROC LÆSSKÆRMALL
9556 //
9557 PROC LÆSSKÆRM(REF RES)
9558   OUT 160, 15
9559   RES:=INP(178)
9560 ENDPROC LÆSSKÆRM
9561 //
9600 // ***** GRUPPE 6 ***** Indlæsning fra registre (funktioner) **************
9601 //
9602 FUNC FNPORT(NR)
9603   RETURN INP(NR)
9604 ENDFUNC FNPORT
9605 //
9606 FUNC FNX
9607   RETURN INP(168)*256+INP(169)
9608 ENDFUNC FNX
9609 //
9610 FUNC FNY
9611   RETURN INP(170)*256+INP(171)
9612 ENDFUNC FNY
9613 //
9614 FUNC FNDELTAX
9615   RETURN INP(165)
9616 ENDFUNC FNDELTAX
9617 //
9618 FUNC FNDELTAY
9619   RETURN INP(167)
9620 ENDFUNC FNDELTAY
9621 //
9622 FUNC FNLINETYPE
9623   RETURN INP(162) MOD 4
9624 ENDFUNC FNLINETYPE
9625 //
9626 FUNC FNCHRTYPE
9627   RETURN INP(162) DIV 4
9628 ENDFUNC FNCHRTYPE
9629 //
9630 FUNC FNCHRSIZEX
9631   RETURN INP(163) DIV 16
9632 ENDFUNC FNCHRSIZEX
9633 //
9634 FUNC FNCHRSIZEY
9635   RETURN INP(163) MOD 16
9636 ENDFUNC FNCHRSIZEY
9637 //
9638 FUNC FNPENSLET
9639   RETURN (INP(161) MOD 4) DIV 2
9640 ENDFUNC FNPENSLET
9641 //
9642 FUNC FNUPDOWN
9643   RETURN INP(161) MOD 2
9644 ENDFUNC FNUPDOWN
9645 //
9646 FUNC FNSKÆRM
9647   RETURN (INP(161) MOD 16) DIV 8
9648 ENDFUNC FNSKÆRM
9649 //
9650 FUNC FNLÆSSKÆRMALL
9651   EXEC SETXY(X,Y)
9652   RETURN FNLÆSSKÆRM
9653 ENDFUNC FNLÆSSKÆRMALL
9654 //
9655 FUNC FNLÆSSKÆRM
9656   OUT 160, 15
9657   RETURN INP(178)
9658 ENDFUNC FNLÆSSKÆRM
9659 //
9700 // ***** GRUPPE 7 ***** Danske specialkarakterer Æ,Ø,Å,æ,ø,å **************
9701 //
9702 PROC DANSK(S$)
9703   EXEC INITSTATUS
9704   REG:=2*(INP(162)>=8)
9705   XX1:=INP(168+REG)*256+INP(169+REG)
9706   YY1:=INP(170-REG)*256+INP(171-REG)
9707   XSIZE:=INP(163) DIV 16; YSIZE:=INP(163) MOD 16
9708   IF XSIZE=0 THEN XSIZE:=16
9709   IF YSIZE=0 THEN YSIZE:=16
9710   S:=INP(161)
9711   CASE S$ OF 
9712   WHEN "Æ"
9713     OUT 160, 65
9714     XX1:+XSIZE*2
9715     CALL STATUS
9716     OUT 161, 9
9717     EXEC SETREG(XX1,REG)
9718     CALL STATUS
9719     OUT 160, 10
9720     CALL STATUS
9721     EXEC SETREG(XX1,REG)
9722     OUT 161, S
9723     CALL STATUS
9724     OUT 160, 69
9725     CALL STATUS
9726     XX1:=INP(168+REG)*256+INP(169+REG)-XSIZE*3
9727     EXEC SETREG(XX1,REG)
9728     OUT 161, 9
9729     CALL STATUS
9730     OUT 160, 10
9731     CALL STATUS
9732     EXEC SETREG(XX1+XSIZE,REG)
9733   WHEN "Ø"
9734     OUT 160, 79
9735     EXEC SETREG(XX1,REG)
9736     OUT 160, 47
9737   WHEN "Å"
9738     IF YSIZE>3 THEN OUT 163, XSIZE*16+YSIZE+1
9739     IF YSIZE>3 THEN OUT 160, 105
9740     IF YSIZE<4 THEN OUT 160, 33
9741     CALL STATUS
9742     OUT 161, 9
9743     OUT 163, XSIZE*16+YSIZE-1
9744     EXEC SETREG(XX1,REG)
9745     OUT 160, 10
9746     CALL STATUS
9747     OUT 161, S
9748     EXEC SETREG(XX1,REG)
9749     OUT 160, 65
9750     CALL STATUS
9751     OUT 163, XSIZE*16+YSIZE
9752   WHEN "æ"
9753     OUT 160, 97
9754     XX1:+XSIZE*3
9755     CALL STATUS
9756     OUT 161, 9
9757     EXEC SETREG(XX1,REG)
9758     CALL STATUS
9759     OUT 160, 10
9760     CALL STATUS
9761     XX1:-XSIZE
9762     EXEC SETREG(XX1,REG)
9763     OUT 161, S
9764     CALL STATUS
9765     OUT 160, 101
9766     CALL STATUS
9767   WHEN "ø"
9768     OUT 160, 100
9769     CALL STATUS
9770     OUT 161, 9
9771     EXEC SETREG(XX1+XSIZE*2,REG)
9772     OUT 160, 10
9773     CALL STATUS
9774     EXEC SETREG(XX1+XSIZE*3,REG)
9775     OUT 160, 10
9776     CALL STATUS
9777     OUT 161, S
9778     EXEC SETREG(XX1+XSIZE*4,REG)
9779     OUT 160, 119
9780     CALL STATUS
9781     OUT 161, 9
9782     EXEC SETREG(XX1+XSIZE*5,REG)
9783     OUT 160, 10
9784     CALL STATUS
9785     CALL STATUS
9786     CALL STATUS
9787     OUT 161, S
9788     EXEC SETREG(XX1,REG)
9789     OUT 160, 122
9790     CALL STATUS
9791   WHEN "å"
9792     IF YSIZE>4 THEN 
9793       FAKT:=1
9794     ELSE 
9795       FAKT:=0
9796     ENDIF 
9797     OUT 163, XSIZE*16+YSIZE+FAKT
9798     OUT 160, 105
9799     CALL STATUS
9800     OUT 161, 9
9801     OUT 163, XSIZE*16+YSIZE-2*FAKT
9802     EXEC SETREG(XX1,REG)
9803     IF YSIZE<5 THEN 
9804       OUT 160, 11
9805     ELSE 
9806       OUT 160, 10
9807     ENDIF 
9808     CALL STATUS
9809     OUT 163, XSIZE*16+YSIZE
9810     EXEC SETREG(XX1,REG)
9811     OUT 161, S
9812     OUT 160, 97
9813     CALL STATUS
9814   ENDCASE 
9815   OUT 161, S
9816 ENDPROC DANSK
9817 //
9818 PROC SETREG(X1, R)
9819   OUT 168+R, X1 DIV 256
9820   OUT 169+R, X1 MOD 256
9821 ENDPROC SETREG
«eof»