\ DOUCHE-prg voor noForth t, AN
\ gebruikt FOR NEXT CH SHIELD V: FRESH

v: fresh vocabulary DOUCHE
v: douche definitions

\ --- Intro
hex
: 16bits ( x -- x' ) FFFF and ;
: 8bits  ( x -- x' ) FF and ;
: 4bits  ( x -- x' ) 0F and ;

decimal
0 value RND
: RANDOM  ( -- u ) rnd 31421 * 6927 + 16bits dup to rnd ;
: 256KIES ( -- n ) random 8 rshift ;        \ n in [0,FF]

: PAGE ( -- ) 12 emit ; \ schoon scherm

\ ------------ Patroon ontwerpen
create TEGEL 16 dup * allot
: WIS     ( -- )         tegel 256 0 fill ;
: HV>POS  ( h v -- pos ) 4bits 4 lshift swap 4bits or ;
: POS>ADR ( pos -- adr ) 8bits tegel + ;
: PLOT    ( ch h v -- )  hv>pos pos>adr c! ;

: PLOT9 ( pos -- ) \ plot een steen met pantser van puntjes
    ch . swap               \ dot pos
    dup 4 rshift >r         \ dot h   r: v
    2dup 1+ r@ 1+ plot
    2dup 1+ r@ 1- plot
    2dup 1- r@ 1+ plot
    2dup 1- r@ 1- plot
    2dup    r@ 1+ plot
    2dup    r@ 1- plot
    2dup 1+ r@    plot
    2dup 1- r@    plot nip
    ch @ swap r>  plot ;

: STAP ( pos -- pos+101 ) 101 + 8bits ;

(* --- Kale oplossing
   : ZET ( -- pos ) 256kies
       begin dup pos>adr c@ while stap repeat plot9 ;
   : P ( x -- ) to rnd wis 16 for zet next ;    \ Lukt zeker 16 keer
*)

\ --- Oplossing voor instelbaar aantal witte steentjes
0 value N?  \ aantal witte steentjes
: ZET? ( -- gelukt? )       256kies dup
    begin dup pos>adr c@    while stap 2dup =
    until <> exit           then plot9 drop true ;
: P ( x -- ) to rnd wis
    n? 0 do zet? 0= if leave then loop ;   \ Stopt indien vol

\ ---------------------- Service
0 value HORIZ   0 value VERTI   \ voor lay-out
0 value PUNTJES?                \ puntjes ook afdrukken?
: N        ( n -- ) to n? ;
: .NORMAAL ( -- ) false to puntjes? ;
: .PUNTJES ( -- ) true  to puntjes? ;
: FORMAAT  ( horiz verti -- )
    6 min 1 max to verti   10 min 1 max to horiz ;
: INIT     ( -- ) .normaal 7 4 formaat 16 n ;

\ ---------------------- Patroon afdrukken
: PEMIT ( ch -- ) space
    puntjes? if bl max emit exit then
    ch .  over < if emit exit then
    drop space ;
: PTYPE ( a n -- )         for count pemit next drop ;
: .LAAG ( adr horiz -- )   for dup 16 ptype next drop ;
: .BAND ( -- )    tegel 16 for cr dup horiz .laag 16 + next drop ;
: .PF   ( -- )  page verti for .band next cr ;
: .P    ( horiz verti -- ) formaat .pf ;

init
v: forth definitions
shield DOUCHE\
douche
\ <><>

(*  demo
 -876  \ startnr
 dup p .pf dup . 1+ 2000 ms many drop
*)