002
17.10.2016, 19:39 Uhr
maleuma
|
Quellcode: | .PL86 .PO6 CR ." MiniCAD (c) W.Domschke" CR ." 06.04.89 " : ==> CR ." SCR " BLK ? ." OK. " ?TERMINAL 9 ?ERROR (COMPILE) --> ; IMMEDIATE DECIMAL VOCABULARY drawd IMMEDIATE drawd DEFINITIONS VOCABULARY entwurf IMMEDIATE VOCABULARY darst IMMEDIATE VOCABULARY bilder IMMEDIATE VOCABULARY hand IMMEDIATE VOCABULARY zeichen IMMEDIATE 1024 CONSTANT 1c 64 CONSTANT m0 0 CONSTANT X 2 CONSTANT Y 4 CONSTANT md ( 8 CONSTANT pc ) 10240 CONSTANT Banf : Bend (( ' bilder CFA 6 + )) LITERAL @ ; : VECTOR <BUILDS 0 , 0 , DOES> + ; : MATRIX <BUILDS 1c , 0 , 0 , 1c , DOES> SWAP 2 * + + ; : ?MSG SWAP IF MESSAGE ELSE DROP ENDIF ; HEX 0 VARIABLE adr 0 VARIABLE dwi ( Drehwinkel) 0 VARIABLE nst 7 VARIABLE pp ( Paper) 8 VARIABLE sw ( SCHRITTWEITE) 0 VARIABLE GP ( GRAFIK-Point) 0 VARIABLE hva 0 VARIABLE GP0 0 VARIABLE kt m0 VARIABLE mst 0 VARIABLE beli ( Bef-Liste) 0 VARIABLE (bl) 3A ALLOT 0 VARIABLE V24 HEX 290 CONSTANT XK 292 CONSTANT YK 2A8 CONSTANT XM 2AA CONSTANT YM 2AC CONSTANT LP 2AE CONSTANT L1 2B0 CONSTANT L2 29E CONSTANT XE 2A0 CONSTANT YE 2A4 CONSTANT p/d 2B2 CONSTANT z/l CREATE pinit CD C, 2B8 , C3 C, NEXT , SMUDGE CREATE lin CD C, 2BB , E5 C, C3 C, NEXT , SMUDGE : linie YE ! XE ! lin 0D ?MSG ; CREATE (vkr) CD C, 2C1 , E5 C, C3 C, NEXT , SMUDGE HEX 40 VARIABLE mpl 20 BLOCK VARIABLE sADR 1F0 VARIABLE sZ 0 VARIABLE d/s 0 VARIABLE fd ( FORTH/DRAWD) 0 VARIABLE fix 0 VARIABLE Abst 0 VARIABLE end 0 VARIABLE pdi VECTOR P3 VECTOR bn0 ( vor-Nullpunkt) VECTOR n0p ( Plotter-Nullp) VECTOR dxy ( Spiegelung x y) VECTOR null ( NULLPUNKT) MATRIX Mb 0 VARIABLE bef ( Befehl) 0 VARIABLE (bz) 3A ALLOT 0 VARIABLE (blb) 3A ALLOT 0 VARIABLE dri 10 CONSTANT xxx 10 CONSTANT yyy 0 CONSTANT zzz 3 CONSTANT x 7 CONSTANT y 0 CONSTANT z VECTOR gcu ( Grafikcursor) : vkr (vkr) DROP ; CREATE v24i CD C, 2C7 , C3 C, NEXT , SMUDGE CREATE hcopy CD C, 2CA , C3 C, NEXT , SMUDGE CREATE panf CDC5 , 2CD , C3C1 , NEXT , SMUDGE CREATE tkr CD C, 2BE , E5 C, C3 C, NEXT , SMUDGE CREATE RISET E1 C, CD C, 2C4 , C3 C, NEXT , SMUDGE : TKR YE ! XE ! tkr DROP ; : m* mst @ m0 */ ; : ltyp m* L2 ! m* L1 ! m* LP ! ; : GTYP 0 MAX 3 MIN -DUP 0= IF 0 0 0 ltyp ELSE 1 - -DUP 0= IF 10 40 40 ltyp ELSE 1 - 0= IF 40 10 10 ltyp ELSE 10 40 10 ltyp ENDIF ENDIF ENDIF ; CREATE pEMIT 7DE1 , 021E , CD C, F00C , C3 C, NEXT , SMUDGE : goto p/d @ IF z/l @ 0 z/l ! >R linie R> z/l ! ELSE YK ! XK ! ENDIF ; : PD 1 z/l ! ; : PU 0 z/l ! ; : DQU CR CR BEGIN 9 EMIT ." ok " CR 0 0 goto QUERY INTERPRET fd @ 0= UNTIL ; : dtxt 20 8 0 2 WINDOW 3 0 COLOR ." MiniCAD" 0 5 COLOR 20 8 1 1F WINDOW 0C EMIT ; : HCOPY V24 @ 0= IF v24i 0FF V24 ! ENDIF hcopy ; CR ." pixad " CR HEX CREATE pixad 88DB , D7CB , 88D3 , D1E1 , 65C5 , 073E , 01A3 , 0080 , 28B7 , CB07 , CB19 , 3D18 , F920 , CBC5 , CB3B , CB3B , 6B3B , 03CD , 34F0 , C1D1 , D5E5 , 88DB , 97CB , 88D3 , C3 C, NEXT , SMUDGE .CP5 : DRAWD dtxt A 1 COLOR ." DRAWD" drawd (COMPILE) bilder DEFINITIONS CR 7 INK CR ." FORTH" CR ." CLS" CR ." MENU" CR ." ENTWURF" CR ." DARSTEL" CR ." HAND" CR ." ZEICHEN" CR ." BLIST dummy " CR ." y SETSCR" CR ." BTEXT dummy" CR ." K6313" CR ." K6304" CR ." ?BILDER" CR 0 6 COLOR ; : MENU DRAWD ; : (V) CR ." MiniCAD (V 2.82)" CR 60 EMIT ." wedo " CR ; CREATE drwahl CDE1 , 033A , C3 C, NEXT , SMUDGE : K6313 00 drwahl ; : K6304 FF drwahl ; darst DEFINITIONS : MENU dtxt A 1 COLOR ." DARSTEL" CR CR 7 INK ." DRAWD" CR ." 16:16" CR ." xxx :16" CR ." N0" CR ." xxx yyy NULLSET" CR ." z paper" CR ." y INKP" CR ." HCOPY" CR ." DISPLAY" CR ." PLOTTER" CR ." CLS" CR ." MENU" CR ." ZEICHNE" CR ." LOESCHE" CR ." XSPIEGL" CR ." YSPIEGL" CR ." zzz GRAD " CR ." z GTYP" CR ." GRAPH" CR ." ACHSEN" CR ." ?BILDER" CR CR 0 6 COLOR ; entwurf DEFINITIONS : MENU dtxt A 1 COLOR ." ENTWURF " CR 7 INK ." DRAWD" CR ." 16:16" CR ." xxx :16" CR ." N0" CR ." xxx yyy NULLSET" CR ." NULL" CR ." ACHSEN" CR ." y paper" CR ." x INKP" CR ." CLS" CR ." RASTER" CR ." ZOOM" CR ." 1GMODE" CR ." PGMODE" CR ." GCLEAR" CR ." FGMODE" CR ." DEFBILD dummy " CR 0 6 COLOR ; HEX drawd DEFINITIONS : V+ >R ROT + R> ROT + ; : 2ROT ROT ROT ; : VOVER >R >R 2DUP R> 2ROT R> 2ROT ; : 2SWAP >R 2ROT R> 2ROT ; : DISPLAY p/d @ IF mpl @ mst ! 0 0 goto 0 p/d ! X n0p @ DUP X null ! X bn0 ! Y n0p @ DUP Y null ! Y bn0 ! ENDIF ; : PLOTTER p/d @ 0= IF mst @ mpl ! m0 mst ! X null @ X n0p ! Y null @ Y n0p ! 0 X null ! 0 Y null ! 0 X bn0 ! 0 Y bn0 ! 1 p/d ! ENDIF 5 BUSIN 20 AND IF pinit ENDIF ; : pCR 0A pEMIT 0D pEMIT ; : pTYPE 0 DO DUP C@ pEMIT 1+ LOOP DROP ; : Iof 88 BUSIN FB AND 88 BUSOUT ; : rck X gcu @ Y gcu @ ; : Ion 88 BUSIN 4 OR 88 BUSOUT ; : wck Y gcu ! X gcu ! ; : rp1 XK @ YK @ ; : wp1 YK ! XK ! ; : rp2 XM @ YM @ ; : wp2 YM ! XM ! ; : rnp X null @ Y null @ ; : wnp Y null ! X null ! ; : Pdis rck Y null @ - m0 mst @ */ SWAP X null @ - m0 mst @ */ CR ." x=" . CR ." y=" . CR ; : CU0 X bn0 @ 0 MAX 0FF MIN Y bn0 @ 0 MAX 0FF MIN wck ; : 2* 2 * ; : 0> MINUS 0< ; : 0>= 0< 0= ; : 0<= 0> 0= ; : 2- ROT SWAP - 2ROT - SWAP ; : l rck linie ; : rp3 X P3 @ Y P3 @ ; : wp3 Y P3 ! X P3 ! ; : NULLSET DUP Y null ! Y bn0 ! DUP X null ! X bn0 ! ; : v rp1 X gcu @ OVER linie rck linie OVER Y gcu @ linie linie rck goto ; : M1 1c X X Mb ! 0 X Y Mb ! 0 Y X Mb ! 1c Y Y Mb ! m0 p/d @ 0= IF md / ENDIF DUP mst ! hva ! 1c X dxy ! 1c Y dxy ! 0 dwi ! ; CREATE bita E1 C, 7C C, 65 C, 6F C, E5 C, C3 C, NEXT , SMUDGE : xor OVER I@ XOR SWAP I! ; : 16:16 M1 ; : ccu rck 0FF SWAP - 9 0 DO 2DUP 4 - I + pixad xor LOOP 9 0 DO 2DUP SWAP 4 - I + SWAP pixad xor LOOP DROP DROP ; : setc ccu rck ROT + 0FF AND ROT ROT + 0FF AND SWAP wck ccu pdi @ IF 0 B7A0 I! Pdis ENDIF ; : G* 1c */ ; : cc! GP @ C! 1 GP +! ; : cd! GP @ ! 2 GP +! ; : ck! Y bn0 @ - m0 mst @ */ cd! X bn0 @ - m0 mst @ */ cd! ; : cc@ GP @ C@ 1 GP +! ; : cd@ GP @ @ 2 GP +! ; : ck@ cd@ cd@ SWAP 2DUP X X Mb @ G* X Y Mb @ ROT G* + ROT ROT Y X Mb @ G* Y Y Mb @ ROT G* + X null @ + SWAP Y null @ + ; : N0 80 DUP NULLSET ; : zs* DUP X Mb @ ROT G* SWAP Y Mb @ ROT G* + ; DECIMAL : <s> DUP 1+ * / G* MINUS 1c + ; : sin 3600 MOD DUP 0< IF 3600 + ENDIF DUP 2700 > IF 3600 - ENDIF DUP 900 > IF 1800 SWAP - ENDIF 1609 900 */ DUP DUP G* DUP 1c SWAP 6 <s> OVER 4 <s> SWAP 2 <s> G* ; : cos 900 SWAP - sin ; HEX : Achs 100 0 DO DUP 1 SWAP I SWAP PIX 4 +LOOP DROP 100 0 DO DUP 1 SWAP I PIX 4 +LOOP DROP ; ( Achsen) : M*M 2DUP X zs* >R Y zs* >R 2DUP X zs* >R Y zs* Y Y Mb ! R> X Y Mb ! R> Y X Mb ! R> X X Mb ! ; ( Multiplikation xy yy xx yx ->) : Nst rnp Achs ; : ACHSEN Nst ; : Mbr mst @ 1c m0 */ 0 2DUP SWAP M*M dwi @ -DUP IF DUP cos SWAP sin 2DUP MINUS SWAP M*M 0 dwi ! ENDIF Y dxy @ 0 0 X dxy @ M*M 1c X dxy ! 1c Y dxy ! m0 mst ! ; ( Rechne Mb aus Maszstab, Dreh winkel, Spiegelung) : rMb X X Mb @ X Y Mb @ Y X Mb @ Y Y Mb @ ; : wMb Y Y Mb ! Y X Mb ! X Y Mb ! X X Mb ! ; : \r DUP @ MINUS DUP ROT ! ; : <r> \r 0< IF ." ]" ELSE ." _" ENDIF ; HEX : akt cc@ DUP >R 40 - DUP 0< OVER 1B > OR 0= IF DUP + beli @ + @ CFA EXECUTE ELSE DROP ENDIF R> ; : ENTWURF (COMPILE) bilder DEFINITIONS (COMPILE) entwurf entwurf MENU ; : DARSTEL (COMPILE) bilder DEFINITIONS (COMPILE) darst darst MENU ; HEX : gs DUP 08 = IF sw @ MINUS 0 setc ELSE DUP 09 = IF sw @ 0 setc ELSE DUP 0A = IF 0 sw @ MINUS setc ELSE DUP 0B = IF 0 sw @ setc ENDIF ENDIF ENDIF ENDIF ; : sw! DUP DUP 30 > SWAP 3A < AND IF DUP 30 - sw ! ENDIF ; : tainprt ccu BEGIN 1FD C@ DUP 1F = IF DROP 5C ENDIF DUP gs sw! 40 - DUP 0< SWAP DUP 1C > ROT OR 0= IF DUP bef @ - IF DUP bef ! 2 * beli @ + @ CFA EXECUTE 7 EMIT ELSE DROP ENDIF ELSE DROP 20 bef ! ENDIF 3 = UNTIL ccu ; : bdat CR DECIMAL mst ? ." :16" CR ; : txt dtxt A 1 COLOR ." GMODE" CR CR 7 INK ." Abst" CR ." Bildmde" CR ." Charmde" CR ." Distnz" CR ." Echo" CR ." Farbe" CR ." Gtyp" CR ." Hintgrd" CR ." Intmitt" CR ." Kreis" CR ." Linie" CR ." Mittpkt" CR ." Punkt" CR ." Richtg" CR ." Setzpkt" CR ." Teilkrs" CR ." Viereck" CR ." DELete" CR ." BRK" 0 6 COLOR bdat 20 8 18 08 WINDOW ; : paper 7 AND 101 * Ion B000 A800 DO DUP I @ F8F8 AND OR I ! 2 +LOOP Iof pp ! ; : btxt dtxt A 1 COLOR ." BILDMODE" 7 INK CR ." Drehwi" CR ." Farbe" CR ." Loesch" CR ." Maszstb" CR ." Xspiegl" CR ." Yspiegl" CR ." Zeichne" CR ." BRK" bdat 20 8 12 0E WINDOW 0 6 COLOR ; : ctxt dtxt A 1 COLOR ." CHARMODE" 0 6 COLOR CR ; : _ pp @ PAPER 0 20 0 20 WINDOW 0C EMIT 20 8 1 1F WINDOW 1C 0 LOC 02 EMIT ; : .. 100 8 DO 1 I 100 8 DO 2DUP I PIX 8 +LOOP DROP DROP 8 +LOOP ; : ^^ _ .. CU0 ; : FORTH 0 28 0 20 WINDOW 0 7 COLOR 0C EMIT 0E0 S0 ! SP! (COMPILE) FORTH DEFINITIONS 0 fd ! ; : INPUT BEGIN 1FD C@ 0= UNTIL QUERY 20 WORD HERE NUMBER DROP ; : CLS _ ; : RASTER .. ; : NULL N0 CU0 .. ccu BEGIN 1FD C@ gs sw! 3 = UNTIL ccu rck 2DUP wnp Y bn0 ! X bn0 ! Nst ; : GCLEAR PAD 100 + DUP GP0 ! GP ! 3 cc! DISPLAY ; : START DECIMAL N0 CU0 M1 panf 7 pp ! 0 INKP ^^ DRAWD rnp wp1 FIRST @ 4 - S0 ! SP! GCLEAR (COMPILE) bilder DEFINITIONS (V) 1 fd ! 80 DUP X n0p ! Y n0p ! DQU ; FORTH DEFINITIONS : MCAD drawd (COMPILE) drawd START ; drawd DEFINITIONS : Bi ck@ wnp cd@ EXECUTE ; : Di cd@ dwi ! ; : Fi cd@ INKP ; : Hi cd@ DUP pp ! paper ; : Ii BLINKP ; HEX : Ki ck@ goto vkr ; : Li ck@ wck l ; : Mi cd@ mst ! ; : Pi ck@ wp2 ; : Ri dri @ 0= DUP dri ! RISET ; : Si ck@ goto ; : kco ck@ rnp 2- ; : Ti ck@ kco kco >R * SWAP R> * - 0> DUP dri ! RISET TKR ; : indel BEGIN 1FD C@ 0= UNTIL 0 BEGIN DROP 1FD C@ DUP 1F = OVER 1A = OR UNTIL ; 101 VARIABLE (anla) B07 , 103 , 303 , 103 , 501 , 305 , 101 , 105 , 501 , 10D , 105 , 101 , 101 , : ALAE DUP C@ 40 - 1B MIN 0 MAX DUP 3 = IF DROP BEGIN 1+ DUP C@ F3 = UNTIL 1+ ELSE DUP 0= IF DROP BEGIN 1+ DUP C@ 5B = UNTIL 1+ ELSE (anla) + C@ + ENDIF ENDIF ; drawd DEFINITIONS : Ui ; : Vi ck@ wck v ; : Xi X dxy \r DROP ; : Wi ; : Yi Y dxy \r DROP ; : Mbi CR ." Mstb:" CR INPUT DUP md * DUP mst ! 4D cc! cd! CR 3 .R ." :" m0 md / 2 .R CR ; : -bi dxy <r> ; : Ybi Y -bi ." Y" CR 59 cc! ; : Xbi X -bi ." X" CR 58 cc! ; drawd DEFINITIONS HEX : #d ; : ,> DUP , ; ' #d VARIABLE (zbl) ( 20-58) ' #d ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> ,> , : >\ rMb mst @ dwi @ X dxy @ Y dxy @ rnp ; : \> wnp Y dxy ! X dxy ! dwi ! mst ! wMb ; : BRK 3 cc! ; : (zri) rck wnp 20 - 2 * (zbl) + @ CFA EXECUTE ; : Zi ck@ wck >\ cd@ dwi ! cd@ mst ! Mbr BEGIN cc@ DUP 0F3 - WHILE (zri) REPEAT DROP \> ; HEX : Zr ctxt 43 cc! rck ck! ccu >\ CR ." Schrift-groesse" CR INPUT DUP mst @ m0 */ mst ! CR ." Schrift-winkel" CR INPUT DUP dwi ! cd! cd! rck Mbr CR CR ." TEXT: " CR 20 8 C 10 WINDOW QUERY 0 WORD HERE COUNT 0 DO DUP C@ DUP 1F > OVER 60 < AND IF DUP cc! (zri) ELSE DROP ENDIF 1 + LOOP DROP 0F3 cc! wck \> ccu 0 TIB @ ! 0 IN ! txt ; : Zbi rck wnp 1 z/l ! adr @ EXECUTE 1 nst ! ; : Rbi PU adr @ EXECUTE 0 nst ! PD ; : Dbi CR ." Dreh- winkel:" CR INPUT DUP dwi ! 44 cc! cd! ; : Fr CR ." Farbe:" CR INPUT DUP INKP 46 cc! cd! ; : ?stack SP@ S0 @ > 1 ?ERROR SP@ GP @ 200 + < 7 ?ERROR 1FD C@ 3 = 9 ?ERROR ; : Gi cd@ GTYP ; : !! OVER ! 2 + ; (bz) ' >\ !! ' TASK !! ' Bi !! ' Zi !! ' Di !! ' TASK !! ' Fi !! ' Gi !! ' Hi !! ' Ii !! ' TASK !! ' Ki !! ' Li !! ' Mi !! ' TASK !! ' TASK !! ' Pi !! ' TASK !! ' TASK !! ' Si !! ' Ti !! ' TASK !! ' Vi !! ' TASK !! ' Xi !! ' Yi !! ' TASK !! ' \> !! : Ar rck SWAP CR ." Ax:" XM @ - m0 mst @ */ . CR YM @ - ." Ay:" m0 mst @ */ . CR ; (blb) ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' Dbi !! ' TASK !! ' Fr !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' Rbi !! ' Mbi !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' Xbi !! ' Ybi !! ' Zbi !! ' TASK !! ' TASK !! : Dr rck SWAP CR ." Dx=" X P3 @ - m0 mst @ */ . CR ." Dy=" Y P3 @ - m0 mst @ */ . CR ; : XCOLOR B7A3 IC@ 7F XOR B7A3 IC! ; : loc 3 0 LOC XCOLOR 2 EMIT EMIT XCOLOR 7 SPACES ; : Bk ck@ wnp 2 GP +! ; : Ck ck@ wck 4 GP +! BEGIN cc@ F3 = UNTIL ; : Kk ck@ 2DUP wck wp1 ; : Tk ck@ wp1 8 GP +! ; ' >\ VARIABLE (blk) ' TASK , ' Bk , ' Ck , ' Di , ' TASK , ' Fi , ' TASK , ' Hi , ' Ii , ' TASK , ' Kk , ' Si , ' Mi , ' TASK , ' TASK , ' Pi , ' TASK , ' TASK , ' Si , ' Tk , ' TASK , ' TASK , ' TASK , ' Xi , ' Yi , ' TASK , ' \> , : del >\ Mbr beli @ (blk) beli ! GP @ GP0 @ DUP ROT MAX SWAP GP ! BEGIN GP @ ALAE OVER < WHILE akt DROP REPEAT DROP GP @ DUP C@ loc rp1 >\ 0 z/l ! (bz) beli ! akt DROP \> wp1 GP ! 1 z/l ! beli ! \> ; : GDEL -1 GP +! del BRK ; : Br btxt CR ." Bild:" CR BEGIN QUERY -FIND DUP 0= IF 20 WORD HERE DUP C@ 1+ TYPE ." ? " CR ENDIF UNTIL DROP CFA adr ! 0 nst ! >\ mst @ hva ! Mbr GP @ 3 cc! DUP 80 + GP ! 40 cc! (blb) beli ! tainprt (bl) beli ! nst @ IF hva @ mst ! 42 cc! rnp ck! adr @ cd! 5B cc! DUP 80 + 2DUP GP @ SWAP - DUP >R CMOVE R> + ENDIF GP ! \> txt 1 z/l ! ; : Er pdi @ FF XOR pdi ! ; : Hr CR ." Hinter- grund:" CR INPUT DUP paper 48 cc! DUP pp ! cd! ; : Ir 49 cc! BLINKP ; : Jr ( 4A) ; : Kr 4B cc! rck 2DUP ck! goto vkr ; : Lr ccu l ccu 4C cc! rck ck! ; : Mr rck 2DUP 50 cc! ck! wp2 ccu ; : Rr 52 cc! dri @ 0= DUP DUP dri ! RISET IF ." -" ELSE ." +" ENDIF ." Richt" CR ; : Pr rck wp3 ." P: " Pdis ; : Sr ccu rck 2DUP goto 53 cc! ck! ; : Ur ; : Tr ccu 54 cc! rck 2DUP ck! TKR 20 10 dri @ IF SWAP ENDIF 2DUP cd! cd! SWAP cd! cd! XK @ YK @ wck ccu ; : Gr CR ." GeradTyp" CR INPUT 0 MAX 3 MIN DUP GTYP 47 cc! cd! ; drawd DEFINITIONS HEX : Vr ccu rp1 X gcu @ OVER 2DUP 4C cc! ck! linie rck 2DUP 4C cc! ck! linie OVER Y gcu @ 2DUP 4C cc! ck! linie 2DUP 4C cc! ck! linie rck 2DUP 53 cc! ck! goto ccu ; : :16 1 MAX 100 MIN M1 mst ! ; (bl) ' TASK !! ' Ar !! ' Br !! ' Zr !! ' Dr !! ' Er !! ' Fr !! ' Gr !! ' Hr !! ' Ir !! ' TASK !! ' Kr !! ' Lr !! ' Mr !! ' TASK !! ' TASK !! ' Pr !! ' TASK !! ' Rr !! ' Sr !! ' Tr !! ' TASK !! ' Vr !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' TASK !! ' del !! : (g) txt (bl) beli ! tainprt BRK ENTWURF X bn0 @ Y bn0 @ wnp ; : FGMODE DISPLAY 1 z/l ! -1 GP +! Nst CU0 rck wp2 Sr (g) 0 dri ! 0 RISET ; : PGMODE GCLEAR M1 6 :16 7 INKP 1 GTYP 8 28 goto F6 28 linie F6 CC linie 8 CC linie 8 28 linie 8 28 NULLSET 0 GTYP FGMODE ; : 1GMODE GCLEAR M1 FGMODE ; : Darst GP @ SWAP GP ! beli @ (bz) beli ! BEGIN akt 03 = UNTIL beli ! GP ! ; : DEFBILD <BUILDS GP0 @ HERE OVER GP @ SWAP - DUP CR . ." lang" CR DUP 0 > IF DUP DP +! CMOVE ENDIF DOES> >R >\ ?stack Mbr R> Darst \> rnp wck ; : XSPIEGL Xi ; : YSPIEGL Yi ; : BSAVE PAD 20 OVER C! DUP 1+ 80 CMOVE 20 WORD HERE PAD 9 CMOVE PAD 9 + 6670 OVER ! 2 + 64 OVER ! 6 + 7F OVER C! 2 + HERE OVER ! 2 + LATEST OVER ! 2 + Banf SWAP ! PAD 1+ 0 R/W HERE Banf DO I 1 R/W 80 +LOOP PAD 2 R/W 5 R/W ; : LOESCHE 0 z/l ! ; : ZEICHNE 1 z/l ! ; : GRAD dwi ! ; : BLOAD 11 EMIT PAD 3 R/W BEGIN SWAP DUP 3 .R 1 - OR WHILE ." *" CR PAD 4 R/W REPEAT ." > " PAD 0B TYPE CR PAD 8 + DUP @ 6670 - OVER 2 + C@ 64 - OR SWAP 8 + C@ 7F - OR IF 5 R/W 8 ERROR ELSE PAD 16 + @ Banf - 8 ?ERROR PAD 14 + @ adr ! PAD 12 + @ DP ! Banf 2 BEGIN OVER 4 R/W OVER 3 .R IF DROP ." ?" 0 ELSE DUP FF = IF ." >" DROP DROP DROP 1 ELSE OVER = IF ." >" 1+ SWAP 80 + SWAP 0 ELSE ." *" 0 ENDIF ENDIF ENDIF UNTIL ENDIF 5 R/W 12 EMIT DROP adr @ (( ' bilder CFA 6 + )) LITERAL ! ; : GRAPH >\ GP0 @ Mbr Darst \> ; : 0GRAPH N0 M1 GRAPH ; hand DEFINITIONS : MENU dtxt A 1 COLOR ." HAND " CR 7 INK ." DRAWD" CR 0 6 COLOR ; : HAND ; drawd DEFINITIONS : HAND (COMPILE) bilder DEFINITIONS hand MENU (COMPILE) hand ; .CP8 : ZOOM CR ." links unten " CU0 ccu BEGIN 1FD C@ gs sw! 03 = UNTIL rck wp1 0B EMIT 0B EMIT rck Achs ." rechts oben " CR BEGIN 1FD C@ sw! DUP 08 = OVER 0A = OR IF sw @ MINUS DUP setc ELSE DUP 09 = OVER 0B = OR IF sw @ DUP setc ENDIF ENDIF 03 = UNTIL 1 z/l ! 100 m0 * X gcu @ XK @ - / nst ! rnp rp1 2- nst @ m0 */ DUP Y bn0 ! Y null ! nst @ m0 */ DUP X bn0 ! X null ! BLINKP v BLINKP rnp nst @ mst @ m0 */ 0 MAX 80 MIN CLS M1 DUP mst ! GRAPH mst ! wnp FGMODE ; hand DEFINITIONS HEX VECTOR H1 : rh1 X H1 @ Y H1 @ ; : wh1 2DUP Y H1 ! X H1 ! ; : ktr mst @ m0 */ Y bn0 @ + SWAP mst @ m0 */ X bn0 @ + SWAP ; : ch! cc! 2DUP cd! cd! ktr ; : BANF GCLEAR -1 GP +! 0 dri ! ; : BEND BRK (COMPILE) drawd (COMPILE) bilder DEFINITIONS ; : F DUP INKP 46 cc! cd! ; : H DUP paper 48 cc! cd! ; : I BLINKP 49 cc! ; : K wh1 4B ch! goto vkr ; : L wh1 4C ch! wck l ; : MP 50 ch! wp2 ; : @@ drawd @ ; HEX : 2DROP DROP DROP ; : S wh1 53 ch! wp1 ; : V wck X gcu @@ Y H1 @@ 4C ch! 2DROP rck 4C ch! 2DROP X H1 @@ Y gcu @@ 4C ch! 2DROP rh1 4C ch! 2DROP rck wh1 53 ch! wck v ; : Th dri ! 54 ch! 2DUP wck TKR 20 10 dri @@ IF SWAP ENDIF 2DUP cd! cd! SWAP cd! cd! rp1 Y bn0 - m0 mst @@ */ Y H1 ! X bn0 - m0 mst @@ */ X H1 ! ; : T+ 0 Th ; : T- 1 Th ; : MST DUP 4D cc! cd! mst ! ; : X 58 cc! drawd X hand -bi ." X " ; : Y 59 cc! drawd Y hand -bi ." Y " ; : D 44 cc! DUP cd! dwi ! ; : B -FIND IF DROP CFA adr ! 40 cc! 42 ch! >R >R >\ R> R> wnp Mbr adr @@ DUP cd! EXECUTE \> 5B cc! ELSE ." ? " 2DROP ENDIF ; : DRAWD BEND drawd MENU ; : DEL GDEL -1 GP +! ; : @ 40 cc! >\ ; : [ 5B cc! \> ; : R Rr ; : M MST ; : P MP ; : T dri @ Th ; : C" 43 cc! >R >R 2DUP cd! cd! wck >\ R> R> 2DUP SWAP cd! cd! dwi ! mst @@ m0 */ mst ! Mbr 22 WORD HERE COUNT 0 DO DUP C@ DUP cc! (zri) 1+ LOOP DROP F3 cc! \> ; : >S @ ; : S> [ ; zeichen DEFINITIONS HEX : MENU dtxt A 6 COLOR ." ZEICHEN " CR 7 1 COLOR ." DRAWD" CR ." ZGMODE" CR ." ZBILD dummy " CR ." ' dummy cc >ZBT" CR 0 6 COLOR ; : ZBILD (COMPILE) zeichen DEFINITIONS <BUILDS GP0 @ HERE OVER GP @ SWAP - DUP CR . ." lang" CR DUP 0 > IF DUP DP +! CMOVE ENDIF DOES> >R >\ ?stack R> Darst rp1 wck \> ; : ZGMODE N0 ^^ 1 rnp 30 0 PLOT 0 40 PLOT -30 0 PLOT 0 -40 PLOT DROP DROP DROP GCLEAR 40 :16 FGMODE (COMPILE) zeichen MENU ; : >ZBT 20 MAX 7F MIN 20 - 2 * (zbl) + ! ; : DRAWD (COMPILE) drawd (COMPILE) bilder DEFINITIONS drawd MENU ; HEX drawd DEFINITIONS : sEMIT d/s @ IF sADR @ C! 1 sADR +! sZ @ 1 - -DUP IF sZ ! ELSE 1F0 sZ ! 12 sADR +! ENDIF ELSE EMIT ENDIF ; : sTYPE sZ @ OVER < IF sZ @ 12 + sADR @ + 6 sZ ! 20 sEMIT 3D sEMIT 3D sEMIT 3E sEMIT sADR ! 1F0 sZ ! ENDIF 0 DO DUP C@ 7F AND sEMIT 1+ LOOP DROP ; : sSPACE 20 sEMIT ; : sSPACES 0 DO sSPACE LOOP ; : s. S->D DECIMAL <# SWAP OVER DABS #S SIGN #> sTYPE sSPACE ; : SETSCR BLOCK sADR ! 1F0 sZ ! ; : ZEICHEN (COMPILE) zeichen zeichen MENU ; : sEM sEMIT 2 sSPACES ; : (s") R COUNT DUP 1+ R> + >R sTYPE ; : s" 22 STATE @ IF COMPILE (s") WORD HERE C@ 1+ ALLOT ELSE WORD HERE COUNT sTYPE ENDIF ; IMMEDIATE .CP18 : /bt/ d/s ! s" HAND BANF DECIMAL " -FIND 0= B ?ERROR OVER CFA @ D2A5 - B ?ERROR OVER NFA 1+ SWAP 1F AND 4 sSPACES 2E sEMIT 22 sEMIT 2 sSPACES sTYPE 22 sEMIT 4 sSPACES DUP 2 + GP ! NFA BEGIN cc@ DUP 3 - WHILE DUP 40 < OVER 5B > OR IF ." >" . ." < " 0B MESSAGE CR ELSE DUP 49 = OVER 52 = OR OVER 58 = OR OVER 59 = OR OVER 40 = OR OVER 5B = OR IF sEM ( @IRXY[:1Byte) ELSE DUP 46 = OVER 48 = OR OVER 4D = OR OVER 44 = OR IF cd@ s. sEM ( FHDM:3Byte) ELSE DUP 4B = OVER 4C = OR OVER 50 = OR OVER 53 = OR OVER 56 = OR IF cd@ cd@ s. s. sEM ( KLPSV:5Byte) ELSE DUP 42 = IF cd@ cd@ s. s. sEM cd@ 2+ NFA 1+ DUP 1 - C@ 1F AND sTYPE sSPACE ( B:7Byt) ELSE DUP 43 = IF cd@ cd@ s. s. cd@ s. cd@ s. sEMIT 22 sEMIT sSPACE BEGIN cc@ DUP F3 - WHILE sEMIT REPEAT DROP 22 sEMIT sSPACE ( C:10+nByte) ELSE DUP 54 = IF cd@ cd@ s. s. sEMIT cd@ 10 = IF 2B ELSE 2D ENDIF sEM cd@ cd@ cd@ DROP DROP DROP ( T:13Byte) ELSE EMIT ." ?? " ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF REPEAT DROP 1+ DUP 1 - C@ 1F AND s" BEND DEFBILD " sTYPE ; : BLIST sADR @ sZ @ FF SETSCR 0 /bt/ sZ ! sADR ! ; : BTEXT 1 /bt/ ; N0 64 :16 FIRST @ 2 - S0 ! SP! zeichen DEFINITIONS hand BANF DECIMAL ." '" 48 0 S BRK ZBILD " hand BANF ." '!" 8 16 S 8 20 L 8 28 S 8 56 L 24 0 S BRK ZBILD "! hand BANF ." '''" 8 48 S 8 56 L 16 56 S 16 48 L 24 0 S BRK ZBILD "" hand BANF ." '#" 16 16 S 16 48 L 32 48 S 32 16 L 40 24 S 8 24 L 8 40 S 40 40 L 48 0 S BRK ZBILD "# hand BANF ." '$" 8 16 S 32 16 L 40 24 L 32 32 L 16 32 L 8 40 L 16 48 L 40 48 L 24 56 S 24 8 L 48 0 S BRK ZBILD "$ hand BANF DECIMAL ." '%" 8 56 S 16 56 L 16 48 L 8 48 L 8 56 L 16 48 S 40 56 S 8 16 L 32 24 S 40 24 L 40 16 L 32 16 L 32 24 L 40 16 S 48 0 S BRK ZBILD "% hand BANF DECIMAL ." '&" 32 24 S 8 48 L 16 56 L 24 48 L 8 32 L 8 24 L 16 16 L 32 32 L 40 0 S BRK ZBILD "& hand BANF DECIMAL ." ''" 0 0 S 8 56 S 8 48 L 16 0 S BRK ZBILD "' hand BANF DECIMAL ." '(" 24 56 S 16 56 L 8 48 L 8 24 L 16 16 L 24 16 L 32 0 S BRK ZBILD "( hand BANF DECIMAL ." ')" 8 56 S 16 56 L 24 48 L 24 24 L 16 16 L 8 16 L 32 0 S BRK ZBILD ") hand BANF DECIMAL ." '1" 8 40 S 24 56 L 24 16 L 32 0 S BRK ZBILD "1 hand BANF DECIMAL ." '2" 8 48 S 16 56 L 32 56 L 40 48 L 8 16 L 40 16 L 48 0 S BRK ZBILD "2 hand BANF DECIMAL ." '3" 8 48 S 16 56 L 32 56 L 40 48 L 32 40 L 24 40 L 32 40 L 40 32 L 40 24 L 32 16 L 16 16 L 8 24 L 48 0 S BRK ZBILD "3 hand BANF DECIMAL ." '4" 24 56 S 8 40 L 8 32 L 40 32 L 24 48 S 24 16 L 48 0 S BRK ZBILD "4 hand BANF DECIMAL ." '5" 40 56 S 8 56 L 8 40 L 32 40 L 40 32 L 40 24 L 32 16 L 16 16 L 8 24 L 48 0 S BRK ZBILD "5 hand BANF DECIMAL ." '6" 40 48 S 32 56 L 16 56 L 8 48 L 8 24 L 16 16 L 32 16 L 40 24 L 40 32 L 32 40 L 16 40 L 8 32 L 48 0 S BRK ZBILD "6 hand BANF DECIMAL ." '7" 8 48 S 8 56 L 40 56 L 40 48 L 8 16 L 16 32 S 32 32 L 48 0 S BRK ZBILD "7 hand BANF DECIMAL ." '8" 32 16 S 16 16 L 8 24 L 8 32 L 16 40 L 32 40 L 40 48 L 32 56 L 16 56 L 8 48 L 16 40 L 32 40 L 40 32 L 40 24 L 32 16 L 48 0 S BRK ZBILD "8 hand BANF DECIMAL ." '9" 8 24 S 16 16 L 32 16 L 40 24 L 40 48 L 32 56 L 16 56 L 8 48 L 16 40 L 32 40 L 40 40 L 48 0 S BRK ZBILD "9 hand BANF DECIMAL ." ':" 16 16 S 12 16 L 12 20 L 16 20 L 16 16 L 12 20 S 16 32 S 12 32 L 12 36 L 16 36 L 16 32 L 12 36 S 24 0 S BRK ZBILD ": hand BANF DECIMAL ." ';" 12 20 S 16 20 L 16 16 L 12 16 L 12 20 L 16 16 S 16 12 L 12 8 L 12 36 S 16 36 L 16 32 L 12 32 L 12 36 L 16 32 S 24 0 S BRK ZBILD "; hand BANF DECIMAL ." '<" 24 48 S 8 32 L 24 16 L 32 0 S BRK ZBILD "< hand BANF DECIMAL ." '=" 8 32 S 40 32 L 40 40 S 8 40 L 48 0 S BRK ZBILD "= hand BANF DECIMAL ." '>" 8 48 S 24 32 L 8 16 L 32 0 S BRK ZBILD "> .CP2 hand BANF DECIMAL ." '?" 8 48 S 16 56 L 32 56 L 40 48 L 24 32 L 24 28 L 24 20 S 24 12 L 48 0 S BRK ZBILD "? .CP3 hand BANF DECIMAL ." '@" 8 48 S 16 56 L 32 56 L 40 48 L 40 24 L 32 16 L 16 16 L 8 24 L 16 32 L 24 32 L 32 24 L 24 16 L 48 0 S BRK ZBILD "@ hand BANF DECIMAL ." 'A" 8 16 S 8 40 L 24 56 L 40 40 L 40 16 L 40 32 S 8 32 L 48 0 S BRK ZBILD "A hand BANF DECIMAL ." 'B" 8 16 S 8 56 L 32 56 L 40 48 L 32 40 L 8 40 L 32 40 L 40 32 L 40 24 L 32 16 L 8 16 L 48 0 S BRK ZBILD "B hand BANF DECIMAL ." 'C" 40 48 S 32 56 L 16 56 L 8 48 L 8 24 L 16 16 L 32 16 L 40 24 L 48 0 S BRK ZBILD "C hand BANF DECIMAL ." 'O" 0 0 B "C 40 24 S 40 48 L 48 0 S BRK ZBILD "O hand BANF DECIMAL ." 'D" 8 16 S 8 56 L 32 56 L 40 48 L 40 24 L 32 16 L 8 16 L 48 0 S BRK ZBILD "D hand BANF DECIMAL ." 'F" 8 16 S 8 56 L 40 56 L 32 40 S 8 40 L 48 0 S BRK ZBILD "F hand BANF DECIMAL ." 'E" 0 0 B "F 40 16 S 8 16 L 48 0 S BRK ZBILD "E hand BANF DECIMAL ." 'G" 0 0 B "C 40 24 S 40 36 L 28 36 L 48 0 S BRK ZBILD "G hand BANF DECIMAL ." 'H" 8 16 S 8 56 L 40 56 S 40 16 L 40 40 S 8 40 L 48 0 S BRK ZBILD "H hand BANF DECIMAL ." 'I" 8 16 S 24 16 L 16 16 S 16 56 L 8 56 L 24 56 L 32 0 S BRK ZBILD "I hand BANF DECIMAL ." 'J" 8 24 S 16 16 L 24 16 L 32 24 L 32 56 L 8 56 L 40 0 S BRK ZBILD "J hand BANF DECIMAL ." 'K" 8 16 S 8 56 L 32 56 S 8 32 L 16 40 S 40 16 L 48 0 S BRK ZBILD "K hand BANF DECIMAL ." 'L" 8 56 S 8 16 L 40 16 L 48 0 S BRK ZBILD "L hand BANF DECIMAL ." 'M" 8 16 S 8 56 L 24 40 L 40 56 L 40 16 L 48 0 S BRK ZBILD "M hand BANF DECIMAL ." 'N" 8 16 S 8 56 L 40 16 L 40 56 L 48 0 S BRK ZBILD "N hand BANF DECIMAL ." 'P" 8 16 S 8 56 L 32 56 L 40 48 L 32 40 L 8 40 L 48 0 S BRK ZBILD "P hand BANF DECIMAL ." 'Q" 0 0 B "O 32 24 S 40 16 L 48 0 S BRK ZBILD "Q hand BANF DECIMAL ." 'R" 0 0 B "P 40 16 S 16 40 L 48 0 S BRK ZBILD "R hand BANF DECIMAL ." 'S" 8 24 S 16 16 L 32 16 L 40 24 L 40 32 L 32 40 L 16 40 L 8 48 L 16 56 L 32 56 L 40 48 L 48 0 S BRK ZBILD "S hand BANF DECIMAL ." 'T" 24 16 S 24 56 L 8 56 L 40 56 L 48 0 S BRK ZBILD "T hand BANF DECIMAL ." 'U" 8 56 S 8 24 L 16 16 L 32 16 L 40 24 L 40 56 L 48 0 S BRK ZBILD "U hand BANF DECIMAL ." 'V" 8 56 S 8 40 L 24 16 L 40 40 L 40 56 L 48 0 S BRK ZBILD "V hand BANF DECIMAL ." 'W" 8 56 S 8 24 L 16 16 L 24 24 L 24 40 L 24 24 L 32 16 L 40 24 L 40 56 L 48 0 S BRK ZBILD "W hand BANF DECIMAL ." 'X" 8 16 S 8 20 L 40 52 L 40 56 L 8 56 S 8 52 L 40 20 L 40 16 L 48 0 S BRK ZBILD "X hand BANF DECIMAL ." 'Z" 8 56 S 40 56 L 8 24 L 8 16 L 40 16 L 48 0 S BRK ZBILD "Z hand BANF DECIMAL ." 'Y" 8 56 S 24 40 L 40 56 L 24 40 L 24 16 L 48 0 S BRK ZBILD "Y hand BANF DECIMAL ." 'AE" 0 0 B "A 40 56 S 44 56 L 44 60 L 40 60 L 40 56 L 44 60 S 4 60 S 8 60 L 8 56 L 4 56 L 4 60 L 8 56 S 48 0 S BRK ZBILD "[ hand BANF DECIMAL ." 'OE" 0 0 B "O 40 56 S 44 56 L 44 60 L 40 60 L 40 56 L 44 60 S 4 60 S 8 60 L 8 56 L 4 56 L 4 60 L 8 56 S 48 0 S BRK ZBILD "\ hand BANF DECIMAL ." 'UE" 0 0 B "U 32 56 S 28 56 L 28 52 L 32 52 L 32 56 L 28 52 S 20 52 S 16 52 L 16 56 L 20 56 L 20 52 L 16 56 S 48 0 S BRK ZBILD "] hand BANF DECIMAL ." '^" 8 16 S 24 32 L 40 16 L 48 0 S BRK ZBILD "^ hand BANF DECIMAL ." '_" 0 0 S 48 0 L BRK ZBILD "_ hand BANF DECIMAL ." '-" 8 40 S 40 40 L 48 0 S BRK ZBILD "- hand BANF DECIMAL ." '+" 0 0 B "- 24 56 S 24 24 L 48 0 S BRK ZBILD "+ hand BANF DECIMAL ." '*" 0 0 B "+ 36 52 S 12 28 L 12 52 S 36 28 L 48 0 S BRK ZBILD "* .CP2 hand BANF DECIMAL ." '." 0 0 S 8 16 S 12 16 L 12 20 L 8 20 L 8 16 L 12 20 S 24 0 S BRK ZBILD ". .CP2 hand BANF DECIMAL ." '," 0 0 B ". 12 16 S 12 12 L 8 8 L 24 0 S BRK ZBILD ", hand BANF DECIMAL ." '/" 8 16 S 40 56 L 48 0 S BRK ZBILD "/ hand BANF DECIMAL ." '0" 0 0 B "O 36 52 S 12 20 L 48 0 S BRK ZBILD "0 ' " 32 >ZBT ' "! 33 >ZBT ' "" 34 >ZBT ' "# 35 >ZBT ' "$ 36 >ZBT ' "% 37 >ZBT ' "& 38 >ZBT ' "' 39 >ZBT ' "( 40 >ZBT ' ") 41 >ZBT ' "* 42 >ZBT ' "+ 43 >ZBT ' ", 44 >ZBT ' "- 45 >ZBT ' ". 46 >ZBT ' "/ 47 >ZBT ' "0 48 >ZBT ' "1 49 >ZBT ' "2 50 >ZBT ' "3 51 >ZBT ' "4 52 >ZBT ' "5 53 >ZBT ' "6 54 >ZBT ' "7 55 >ZBT ' "8 56 >ZBT ' "9 57 >ZBT ' ": 58 >ZBT ' "; 59 >ZBT ' "< 60 >ZBT ' "= 61 >ZBT ' "> 62 >ZBT ' "? 63 >ZBT ' "@ 64 >ZBT ' "A 65 >ZBT ' "B 66 >ZBT ' "C 67 >ZBT ' "D 68 >ZBT ' "E 69 >ZBT ' "F 70 >ZBT ' "G 71 >ZBT ' "H 72 >ZBT ' "I 73 >ZBT ' "J 74 >ZBT ' "K 75 >ZBT ' "L 76 >ZBT ' "M 77 >ZBT ' "N 78 >ZBT ' "O 79 >ZBT ' "P 80 >ZBT ' "Q 81 >ZBT ' "R 82 >ZBT ' "S 83 >ZBT ' "T 84 >ZBT ' "U 85 >ZBT ' "V 86 >ZBT ' "W 87 >ZBT ' "X 88 >ZBT ' "Y 89 >ZBT ' "Z 90 >ZBT ' "[ 91 >ZBT ' "\ 92 >ZBT ' "] 93 >ZBT ' "^ 94 >ZBT ' "_ 95 >ZBT HEX CR ." letzter SCR " drawd DEFINITIONS : ?BILDER Bend BEGIN DUP PFA LFA @ SWAP DUP Banf > WHILE ID. REPEAT DROP DROP ; bilder DEFINITIONS HERE ' Banf CFA 2 + ! : DUMMY ; FORTH CR ." Ende des dictionary: " HEX HERE . ." HEX " CR DECIMAL ;S
|
-- Mario. |