Scr#1
\ LOGO SINUSTABEL
CREATE SINTAB
0 , 175 , 349 , 523 , 698 , 872
, 1045 , 1219 , 1392 , 1564 , 17
36 , 1908 , 2079 , 2250 , 2419 ,
 2588 , 2756 , 2924 , 3090 , 325
6 , 3420 , 3584 , 3746 , 3907 ,
4067 , 4226 , 4384 , 4540 , 4695
 , 4848 , 5000 , 5150 , 5299 , 5
446 , 5592 , 5736 , 5878 , 6018
, 6157 , 6293 , 6428 , 6561 , 66
91 , 6820 , 6947 , 7071 , 7193 ,
 7314 , 7431 , 7547 , 7660 , 777
1 , 7880 , 7986 , 8090 , 8192 ,
8290 , 8387 , 8480 , 8572 , 8660
 , 8746 , 8829 , 8910 , 8988 , 9
063 , 9135 , 9205 , 9272 , 9336
, 9397 , 9455 , 9511 , 9563 , 96
13 , 9659 , 9703 , 9744 , 9781 ,
 9816 , 9848 , 9877 , 9903 , 992
5 , 9945 , 9962 , 9976 , 9986 ,
9994 , 9998 , 10000 ,
-->










Scr#2
( Dubbel codeveld implementatie
van VALUE variabelen volgens DTC
 model)

: CFA 3 - ;
   ' : 1+ @ CONSTANT DOCOL

: CRVAL CREATE 205 C,
2 ALLOT IMMEDIATE ;

VARIABLE %VAR 3 %VAR !

: TO 2 %VAR ! ; IMMEDIATE
: +TO 1 %VAR ! ; IMMEDIATE


: (DOVAL) R> %VAR @ PICK >R >R
  DROP 2DROP STATE @ IF R> OVER
  1+ ! , R>  , ELSE 3 + R>
EXECUTE  R> EXECUTE  THEN  3
%VAR ! ;
 : DOVAL COMPILE (DOVAL) 205 C,
 DOCOL , ; IMMEDIATE
: VALUE CRVAL 2 ALLOT DOES>
['] @ ['] ! ['] +! DOVAL ;
: VALARRAY CRVAL DUP + ALLOT
  DOES> ['] @ ['] ! ['] +! DOVAL
  SWAP 2* + ;
: 2+! DUP >R 2@ D+ R> 2! ;
: 2VALUE CRVAL 4 ALLOT
DOES> ['] 2@ ['] 2! ['] 2+!
 DOVAL ; -->

Scr#3
\ LOGO SIN,COS,ONDER
: SIN@ DUP + SINTAB + @ ;
: SIN 360 MOD DUP 90 < IF
  SIN@ ELSE DUP 180 < IF
  180 SWAP - SIN@ ELSE
  DUP 270 < IF 180 - SIN@
  NEGATE ELSE 360 SWAP - SIN@
  NEGATE
  THEN THEN THEN ;
: COS 90 SWAP - SIN ;
VALUE XPOS VALUE YPOS
: HPOS 33 23688 C@ - DUP 32 = IF
 DROP 0 THEN ;
: VPOS 24 23689 C@ - 23688 C@
  1 = IF 1+ THEN 23 MIN ;

: GCUR HPOS 256 U< VPOS 176 U< A
ND IF  175 YPOS - 8 / 32 * XPOS
8 / + 22528 + 128 TOGGLE THEN ;
: QUERY' VPOS HPOS 23693 @ 23695
 @ 23697 C@ 0 INK 7 PAPER 0 INV
0 GOVER 22 0 AT 64 SPACES 22 0 A
T TIB  64 GCUR EXPECT 0 >IN ! 23
697 C! 23695 ! 2393 ! AT GCUR
 SPAN @ #TIB ! 0 TIB SPAN @ + !
; : ONDER BEGIN QUERY' INTERPRET
 0 UNTIL ;
: SETXY TO YPOS TO XPOS ;
VALUE HEADING
: HNORM HEADING 360 MOD TO HEADI
NG ;
: SETH TO HEADING HNORM ; -->

Scr#4
\ LOGO PU,PD,LE,RI,PLOT
: PU 1 GOVER 1 INV ;
: PD 0 GOVER 0 INV ;
: LE +TO HEADING HNORM ;
: RI NEGATE LE ;
: LEFT LE ; : RIGHT RI ;
: PENUP PU ; : PENDOWN PD ;
: HOME 128 87 SETXY 0 SETH ;
: CLS CLS HOME ;
: MYSELF LATEST NAME> , ;
IMMEDIATE





: 2VARIABLE CREATE 4 ALLOT ;
2VARIABLE X1 2VARIABLE Y1
2VARIABLE INCX 2VARIABLE INCY
VALUE W
: WRAP 1 TO W ; : NOWRAP 0 TO W
 ; WRAP
: PLOT 2DUP 176 U< SWAP 256 U<
   AND IF PLOT ELSE W IF X1 @
   255 AND X1 ! Y1 @ 176 U< 0=
   IF 176 Y1 @ 0< 0= IF NEGATE
   THEN Y1 +! THEN 2DROP X1 @ Y1
   @   PLOT ELSE 2DROP THEN THEN
 ;
-->



Scr#5
\ LOGO DRAWTO,FD,BK
: DRAWTO      YPOS DUP 0 SWAP Y1
  2! - DUP ABS ROT XPOS DUP 0
  SWAP X1 2! - DUP ABS ROT MAX
  >R DUP 0< IF ABS 0 SWAP R@
  M/MOD DNEGATE ELSE 0 SWAP R@
  M/MOD THEN  INCX 2! DROP DUP
  0< IF ABS 0 SWAP R@ M/MOD
  DNEGATE ELSE 0 SWAP  R@ M/MOD
  THEN INCY 2! DROP R>  1+ 0 DO
  X1 @ Y1 @ PLOT X1 2@  INCX 2@
  D+ X1 2! Y1 2@ INCY 2@  D+ Y1
  2! LOOP Y1 @ INCY @ -
            TO YPOS X1 @ INCX
   @ -          TO XPOS ;


: FD DUP HEADING SIN 10000 */MOD
  SWAP 4999 2 PICK 0< -  > -  YP
OS +  SWAP HEADING COS 10000 */M
OD  SWAP 4999 2 PICK 0< -  > -
  XPOS + SWAP DRAWTO ;
: BK NEGATE FD ;
: FORWARD FD ; : BACK BK ;
VALUE CNT VALUE IN'
: REP[ STATE @ IF COMPILE 0
  [COMPILE] DO ELSE >IN @ TO IN'
  TO CNT THEN ;  IMMEDIATE

-->



Scr#6
\ LOGO ]R,IF[,PAINT
: ]R STATE @ IF [COMPILE] LOOP
  ELSE -1 +TO CNT CNT IF
  IN' >IN ! THEN THEN ; IMMEDIAT
E : IF[ STATE @ IF [COMPILE] IF
  ELSE 0= IF BEGIN &] WORD
TIB >IN @ + C@ &I = UNTIL
 THEN THEN ; IMMEDIATE
: ]I STATE @ IF [COMPILE] THEN
 THEN ; IMMEDIATE

: PAINT 2DUP 176 U< SWAP 256
  U< AND IF 2DUP POINT 0= IF
  2DUP PLOT
  2DUP 1+ MYSELF
  2DUP SWAP 1+ SWAP MYSELF
  2DUP 1- MYSELF
  2DUP SWAP 1- SWAP MYSELF
  THEN THEN 2DROP ;

-->












Scr#7
\ TEKENPROGRAMMA DEEL 1
VARIABLE SPEED
: ISAVE 23697 C@ 23695 @ 23693 @
 ;
: IRST 23693 ! 23695 ! 23697 C!
;
: .CUR ISAVE 1 GOVER 8 INK 0 INV
 XPOS 4 - 0 MAX YPOS  PLOT XPOS
4 + 255 MIN 23677 C@ - 0 DRAW
 XPOS YPOS 4 - 0 MAX PLOT
 0 YPOS  4 + 175 MIN 23678 C@
 - DRAW IRST      ;
: .POS ISAVE 0 INK 0 GOVER 0 INV
 22 0 AT ." X=" XPOS 3 .R ."  Y=
" YPOS 3 .R IRST ;
: S SPEED @ 8 /
1+ SPEED @ 1 = IF 10 PAUSE THEN
;
: -S S NEGATE ;
: +S 1 SPEED +! SPEED @ 64 MIN S
PEED ! ;

: BESTUUR DUP &S = IF
  .CUR -S +TO XPOS +S XPOS
  0 MAX TO XPOS DROP .CUR .POS
     ELSE DUP &X = IF
  .CUR -S +TO YPOS +S YPOS
  0 MAX TO YPOS DROP .CUR .POS
     ELSE DUP &E = IF
  .CUR S +TO YPOS +S YPOS 175
    MIN TO YPOS DROP .CUR .POS
     ELSE     &D = IF   -->

Scr#8
\ TEKENPROGRAMMMA DEEL 2
  .CUR S +TO XPOS +S XPOS 255
    MIN TO XPOS .CUR .POS
           THEN THEN THEN THEN ;

: KEY BEGIN INKEY 0= WHILE 1 SPE
ED ! REPEAT INKEY ;

VALUE XM VALUE YM
: MARK ISAVE 0 INK 0 GOVER  XPOS
 TO XM YPOS TO YM 22 16 AT ." XM
=" XM 3 .R ." YM=" YM 3 .R IRST
;
: LIJN .CUR XM YM PLOT
  XPOS  XM  - YPOS  YM  -
  DRAW MARK .CUR ;

: PUNT XPOS YPOS PLOT ;
: ROOSTER ISAVE
    1 GOVER 8 INK 23695 @ 23693
  ! 255 0 DO I 0 PLOT 0 175 DRAW
  8 +LOOP 175 0 DO 0 I PLOT 255
  0 DRAW 8 +LOOP IRST ;
: VUL .CUR XPOS YPOS PAINT .CUR
;
: INKT 48 - DUP 8 U< IF DUP 22 3
0 AT 0 INK . INK ELSE  DROP THEN
 ; -->





Scr#9
\ CIRCLE,BOX,BLOK,TEKEN
: CIRCLE -ROT TO YPOS TO XPOS
 XPOS OVER + YPOS PLOT
 370 10 DO XPOS I COS 2 PICK
10000 */ + 23677 C@ - YPOS I SIN
 3 PICK 10000 */ + 23678 C@ -
 DRAW 10 +LOOP  DROP ;

: BOX .CUR XM YM PLOT XPOS XM -
  0 DRAW 0 YPOS YM - DRAW
  XM XPOS - 0 DRAW 0 YM YPOS -
  DRAW MARK .CUR ;

: BLOK .CUR YPOS YM 2DUP < IF SW
AP THEN SWAP 1+ SWAP DO XM I PLO
T XPOS XM - 0 DRAW LOOP
  MARK .CUR ;

: TEKEN SAVE-BUFFERS
  .CUR MARK .POS
  BEGIN INKEY 0= UNTIL
  BEGIN  KEY DUP BESTUUR
  DUP &M = IF MARK THEN
  DUP &L = IF LIJN THEN
  DUP &P = IF VUL THEN
  DUP &R = IF ROOSTER THEN
  DUP &B = IF BLOK THEN
  DUP &K = IF BOX THEN
  DUP &Q = IF PUNT THEN
  DUP INKT
  13 = UNTIL .CUR 22 0 AT ;
  -->

Scr#10
\ RANDOM GENERATOR
VALUE SEED 3 TO SEED
: RANDOM SEED 743 * 43 + DUP
  TO SEED UM* SWAP DROP ;

