;
;  EXTRAS.LSP
;
;  EXTRA APPLE SPECIFIC FUNCTIONS
;
;  RTK, 20-JUL-2008
;  LAST UPDATE: 20-JUL-2008
;

(DEFINE (MOD (LAMBDA (A B)
  (SUB A (MULT B (INT (DIV A B)))))))

(DEFINE (HOME (LAMBDA () (PROGN
  (CALL -936) NIL ) )))
(DEFINE (INVERSE (LAMBDA () (PROGN
  (CALL -384) NIL) )))
(DEFINE (NORMAL (LAMBDA () (PROGN
  (CALL -380) NIL ) )))

; MACHINE CODE ROUTINES ($300)
(PROG (I D)
  (SETQ I 768)
  (SETQ D '(165 51 76 218 253 165 51 166
       44 76 65 249 165 51 164 45 76
           25 248 165 51 164 44 76 40
          248 165 51 164 44 32 113
          248 134 6 96))
  LOOP
    (POKE I (CAR D))
    (SETQ I (ADD I 1))
    (SETQ D (CDR D))
    (COND
      ((NULL D) (RETURN NIL)))
  (GO LOOP) )

(DEFINE (PHEX8 (LAMBDA (N) (PROGN
  (POKE 51 N) (CALL 768)))))

; N MUST BE POSITIVE
(DEFINE (PHEX16 (LAMBDA (N) (PROG (L H)
  (SETQ H (INT (DIV N 256)))
  (SETQ L (MOD N 256))
  (POKE 51 H) (POKE 44 L) (CALL 773)))))

; HLIN X,Y AT Z
(DEFINE (HLIN (LAMBDA (X Y Z) (PROGN
  (POKE 45 X) (POKE 44 Y) (POKE 51 Z)
  (CALL 780) NIL ))))

; VLIN X,Y AT Z
(DEFINE (VLIN (LAMBDA (X Y Z) (PROGN
  (POKE 51 X) (POKE 45 Y) (POKE 44 Z)
  (CALL 787) NIL ))))

; SCRN X,Y
(DEFINE (SCRN (LAMBDA (X Y) (PROG ()
  (POKE 44 X) (POKE 51 Y) (CALL 794)
  (RETURN (PEEK 6)) ))))