;--------------------------- LASER ---------------------------
; game: use your laser on a grid to find where are the mirrors
; ---------------- guillaume.tello@orange.fr -----------------

#ECHO Compile for Printer? (Y/N)
#ASK YN PRINT /

; procedures

#label A  ray
#label E  position
#label A' view
#label E' init

; variables

#reg 0 I                    ; current column
#reg 1 J                    ; current line
#reg 2 dx                   ; horizontal direction (+1 RIGHT, -1 LEFT, 0 none)
#reg 3 dy                   ; vertical direction (+1 UP, -1 DOWN, 0 none)
#reg 4 n+1                  ; upper limit for coordinates
#reg 5 box_type             ; content of one box
#reg 6 score                ; my score
#reg 7 seed                 ; random seed

; arrays

#array grid 8 16            ; the grid

;---------------------------------------------
; returns content of position I=column, J=line
; value stored in box_type
;---------------------------------------------

get_box:
        @J + 7 = STO box_type                   ; pointer to the correct line
        RCL grid(box_type)                      ; the line
        / ( @n+1 - @I ) 10^X                    ; shift right
        = frac * $10 = int                      ; and get the first decimal digit
        STO box_type                            ; what was in that box
RTN

;-------------------------------
; returns 0 if value is 0 or n+1
; so returns 0 if on a border
;-------------------------------

limits:
    * ( CE - @n+1 ) =
RTN

;------------------------------------------------
; col x%t line A to shot a ray from this position
; returns out position or 0,0 if falled in a hole
;------------------------------------------------

LBL ray

    STO J 0 x%t STO I                       ; store I=column and J=line of entry point
    ?PRINT Fix 2                            ; and 0 in T for comparison
    ?PRINT "IN SBR display
     
    @J SBR limits                           ; if 0, then entry point UP or DOWN
    IF(x=t)
        1 - 2 * @J sign =                   ; computes vertical direction (and O in T for dx)
    ELSE
        @I SBR limits                       ; if 0, then entry point RIGHT or LEFT
        IF(x<>t)
            0 1/x RTN                       ; else, not a valid entry point: 9.9999 99 error
        ENDIF    

            1 - 2 * @I sign = x%t           ; computes the horiz direction (in T) and 0 for dy
    ENDIF
    STO dy x%t STO dx                       ; store directions
    
    DEC score                               ; 1 point less
    
    DO
        next_box:
            I+{ @dx }                       ; goes to next box
            J+{ @dy }

            { @I SBR limits x%t
              @J SBR limits * 0 x%t = }     ; expression is nul if on a border

    WHILE(x<>t)                             ; if <>0, go on
        
        SBR get_box                         ; what box type in (I;J)?

        SELECT box_type
            CASE 1 GTO next_box             ; empty, pass
            CASE 2 0 RTN                    ; hole, stop!
            CASE 3
                $-1 PRD dx PRD dy           ; reverse movement
                GTO next_box
            CASE 4
                RCL dx +/-                  ; up right
                EXC dy +/- STO dx
                GTO next_box
            CASE 5           
                RCL dx EXC dy STO dx        ; up left
                GTO next_box
            CASE 6
                RCL dx EXC dy +/- STO dx    ; turn right
                GTO next_box
            DEFAULT
                RCL dy EXC dx +/- STO dy    ; 7=default, turn left
        ENDCASE

    WEND

?PRINT    "^
?PRINT    display: line>>
?PRINT    @J / $100 + @I = MixLine
!PRINT    @J x%t @I                               ; when border reached, display coordinates
RTN

;-----------------------------------
; col x%t line E
; enters coordinates to make a guess
;-----------------------------------

LBL position
?PRINT STO J / $100 + x%t STO I = STO dx
!PRINT STO J x%t STO I         ; fill I and J
    SBR get_box             ; and fill box_type for later guess
    CLR                     ; hides the result!
RTN

;-------------
; make a guess
;-------------

LBL D' 1 +          ; turn left =7
LBL D  1 +          ; turn right=6
LBL C' 1 +          ; mirror \  =5
LBL B' 1 +          ; mirror /  =4
LBL C  1 +          ; back      =3
LBL B  2 =          ; hole      =2
    x%t
    RCL box_type   
    IF(x<>t)        ; IF my guess <> box_type, I loose 5 points!
        ?PRINT "NO line>>
        0 1/x
        $-5         ; error to make it blink
    ELSE
        ?PRINT "OK line>>
        $10         ; if my guess = box_type, then I win 10 points.
    ENDIF
    SUM score       ; modify score
    ?PRINT Fix 2
    ?PRINT RCL dx + x%t * $100 = MixLine
RTN

;---------------------------------------
; A' to view score and R/S to view lines
;---------------------------------------

LBL view
    INV FIX
    RCL score               ; display score
    ?PRINT Prt
    R/S                     ; and stop
    BOT grid STO J          ; starting register for grid
    @n+1 STO I DEC I        ; how many lines
    FOR I
        RCL grid(J)         ; display line
        ?PRINT Prt
        R/S                 ; and stop
        INC J
    LOOP
    CLR                     ; a 0 to say "end of grid".
RTN

;-----------------------------------------------
; obj x%t n E' to init grid n*n with obj objects
; n<=9 and if obj<0 no turnleft/right object
;-----------------------------------------------

; variables

#reg 6 n
#reg 2 obj_nbr
#reg 3 obj_max

; flags

#flag 1 one_hole            ; Set to ON if a hole is still possible
                            ; if one is present, then Set to OFF

LBL init
    STO n STO n+1 INC n+1               ; store n and n+1
    0
    IF(x<t)
        2 +                             ; if object number positive, all mirrors allowed
    ENDIF
        4 =                             ; else, don't put the turn right, turn left mirrors
    STO obj_max                         ; 6 or 4
    x%t ABS STO obj_nbr                 ; and stores number of objects desired

    BOT grid STO J                      ; to parse the grid from bottom to top
    @n STO I 10^x / 9 = INT             ; empty line made of ones

    FOR I
        STO grid(J)                     ; and in every line!
        INC J
    LOOP

    STF one_hole                        ; a hole is still allowed
    
    1 x%t                               ; for comparison
    FOR obj_nbr                         ; number of objects to create
    
        DO
            @n SBR random STO I
            @n SBR random STO J
            SBR get_box
        UNTIL(x=t)                      ; loop until an empty position is found (=1)
        
        7 SUM J                         ; to point in grid
        
        @obj_max SBR random             ; an object (from 1 to max)
        IF(on) one_hole                 ; if flag on
            IF(x=t)                     ; and that's a black hole (=1)
                INV STF one_hole        ; then flag off
                DEC obj_max             ; and one object less from now
            ENDIF
        ELSE                            ; if flag off, no more black holes
            + 1 =                       ; objects from 2 to max
        ENDIF
        * ( @n - @I ) 10^x =            ; value shifted to its postition
        SUM grid(J)                     ; and added to the "1" in the grid
        
    LOOP
    CLR STO score                       ; score = 0
RTN

;-------------------------------
; returns a random integer value
; from 1 to the value in X
;-------------------------------

random:
    * ( ( @seed + pi ) y^x 5 ) frac STO seed + 1 = INT
RTN  

#end