234 lines
7.8 KiB
Common Lisp
234 lines
7.8 KiB
Common Lisp
;;; -*- LISP -*-
|
|
;;; Translated by KLOTZ from MC at 12:33am Thursday, June 11, 1981
|
|
;;; using Fortran.213 running in MacLISP.1914
|
|
;;; Lisp translation file: DSK:HUMOR;GOLDI FLISP
|
|
|
|
;;; Fortran source file: DSK:HUMOR;GOLDI LOCKS
|
|
|
|
|
|
;; Make sure macro support gets loaded
|
|
|
|
(EVAL-WHEN (EVAL COMPILE)
|
|
(COND ((NOT (STATUS FEATURE FORTRAN-TRANSLATOR-MACRO-SUPPORT))
|
|
(LOAD '((DSK FORT) LOADIN COMPLR))
|
|
(SSTATUS FEATURE FORTRAN-TRANSLATOR-MACRO-SUPPORT))))
|
|
|
|
;; Make sure runtime support gets loaded
|
|
|
|
(EVAL-WHEN (EVAL LOAD)
|
|
(COND ((NOT (STATUS FEATURE FORTRAN-TRANSLATOR-RUNTIME-SUPPORT))
|
|
(LOAD '((DSK FORT) LOADIN RUNTIM))
|
|
(SSTATUS FEATURE FORTRAN-TRANSLATOR-RUNTIME-SUPPORT))))
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;; Translation of "STORY" ;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; SUBROUTINE STORY (GOLDIE)
|
|
;;; BY DAVE VANDERWERF AND LESLIE TUREK
|
|
;;; FROM FROM "TWENTY YEARS IN THE TWILIGHT ZONE, " PUBLISHED
|
|
;;; BY THE MIT SCIENCE FICTION SOCIETY. (C) 1980 MASSACHUSETTS
|
|
;;; INSTITUTE OF TECHNOLOGY SCIENCE FICTION SOCIETY
|
|
;;; ONCE UPON A TIME THERE WERE THREE BEARS; A PAPA BEAR, A MAMA BEAR
|
|
;;; AND A BABY BEAR.
|
|
;;; THEY LIVED IN A HOUSE IN THE MIDDLE OF THE WOODS. IT HAD A KITCHEN,
|
|
;;; A LIVINGROOM, AND A BEDROOM.
|
|
;;; ONE DAY THE THREE BEARS WENT FOR A WALK IN THE WOODS.
|
|
;;; GOLDILOCKS CAME TO THE BEARS' HOUSE AND WENT INTO THE KITCHEN. IN
|
|
;;; THE KITCHEN THERE WERE THREE BOWLS OF PORRIDGE; THE PAPA BEAR'S,
|
|
;;; THE MAMA BEAR'S, AND THE BABY BEAR'S.
|
|
;;; GOLDILOCKS TASTED EACH BOWL OF PORRIDGE. PAPA BEAR'S WAS TOO HOT,
|
|
;;; MAMA BEAR'S WAS TOO COLD, BUT BABY BEAR'S WAS JUST RIGHT AND
|
|
;;; SHE ATE IT ALL UP.
|
|
;;; GOLDILOCKS SAT DOWN ON EACH OF THE BEDS. PAPA BEAR'S WAS TOO HARD,
|
|
;;; MAMA BEAR'S WAS TOO SOFT, BUT BABY BEAR'S WAS JUST RIGHT, SO SHE
|
|
;;; LAY DOWN AND WENT TO SLEEP.
|
|
|
|
(FORTRAN (STORY GOLDIE SJSTRT)
|
|
(SUBROUTINE
|
|
(FORTRAN-CALL HARDF BIGF HOTF)
|
|
(FORMAT STORY-FORMAT-100
|
|
|(34H SOMEBODYS BEEN EATING MY PORRIDGE)|)
|
|
(FORMAT STORY-FORMAT-120 |(21H AND HE ATE IT ALL UP)|)
|
|
(FORMAT STORY-FORMAT-140
|
|
|(35H SOMEBODYS BEEN SITTING IN MY CHAIR)|)
|
|
(FORMAT STORY-FORMAT-160 |(16H AND HE BROKE IT)|)
|
|
(FORMAT STORY-FORMAT-180
|
|
|(34H SOMEBODYS BEEN SLEEPING IN MY BED)|)
|
|
(FORMAT STORY-FORMAT-200 |(17H AND THERE SHE IS)|)
|
|
(REAL BED HARDF BEDB BEDM BEDP BROKEN CHAIR BIGF CHAIRB
|
|
CHAIRM CHAIRP PORR HOTF PORRB PORRM PORRP WOODS1 WOODS2
|
|
BEDRM BABY PAPA SJSTRT GOLDIE)
|
|
(INTEGER LVLGRM I LVNGRM KITCHN MAMA)
|
|
(EQUIVALENCE ((BABY 0.) (MAMA 1.) (BEAR 2.) (PAPA 2.))
|
|
((BEDRM 0.) (LVNGRM 1.) (HOUSE 2.) (KITCHN 2.))
|
|
((PORRB 0.) (PORRM 1.) (PORR 2.) (PORRP 2.))
|
|
((CHAIRB 0.) (CHAIRM 1.) (CHAIR 2.) (CHAIRP 2.))
|
|
((ACHAIR 0.) (BROKEN 0.))
|
|
((BEDB 0.) (BEDM 1.) (BEDP 2.) (BED 2.)))
|
|
(DIMENSION (BED 3.) (CHAIR 3.) (PORR 3.) (WOODS1 100.)
|
|
(HOUSE 3.) (WOODS2 100.) (BEAR 3.)))
|
|
;;; Subroutine STORY(GOLDIE,SJSTRT)
|
|
(: PAPA 1.0)
|
|
(: MAMA 2.)
|
|
(: BABY 3.0)
|
|
(: KITCHN 0.)
|
|
(: LVNGRM 0.)
|
|
(: BEDRM 0.0)
|
|
(: I 4.)
|
|
DO-I-10
|
|
(: (WOODS2 I) PAPA)
|
|
(: (WOODS2 (PLUS I (MINUS 1.))) (FLOAT MAMA))
|
|
(: (WOODS2 (PLUS I (MINUS 2.))) BABY)
|
|
;;; ALSO WALKING IN ANOTHER PART OF THE WOODS WAS A LITTLE GIRL NAMED
|
|
;;; GOLDILOCKS.
|
|
/10 (: (WOODS2 (PLUS I (MINUS 3.))) 0.0)
|
|
(COND ((LE (: I (1+ I)) 100.) (GO DO-I-10)))
|
|
(: I 4.)
|
|
DO-I-20
|
|
(: (WOODS1 I) GOLDIE)
|
|
/20 (: (WOODS1 (PLUS I (MINUS 1.))) 0.0)
|
|
(COND ((LE (: I (1+ I)) 100.) (GO DO-I-20)))
|
|
(: KITCHN (FIX GOLDIE))
|
|
(: PORRP 1.0)
|
|
(: PORRM 2.0)
|
|
(: PORRB 3.0)
|
|
(: I 1.)
|
|
DO-I-30
|
|
((LAMBDA (TEMP-VAL)
|
|
(COND ((MINUSP TEMP-VAL) (GO /30))
|
|
((ZEROP TEMP-VAL) (GO /40)) (T (GO /30))))
|
|
(+$ (HOTF (PORR I)) (-$ (HOTF SJSTRT))))
|
|
/30 ;;; CONTINUE
|
|
(COND ((LE (: I (1+ I)) 3.) (GO DO-I-30)))
|
|
(GO /45)
|
|
/40 (: GOLDIE PORRB)
|
|
/45 (: KITCHN (FIX (+$ (FLOAT KITCHN) (-$ GOLDIE))))
|
|
;;; THEN SHE LEFT THE KITCHEN AND WENT INTO THE LIVING ROOM. THERE SHE
|
|
;;; FOUND THREE CHAIRS; PAPA BEAR'S, MAMA BEAR'S. AND BABY BEAR'S.
|
|
(: LVNGRM (FIX GOLDIE))
|
|
(: CHAIRP 1.0)
|
|
(: CHAIRM 2.0)
|
|
(: CHAIRB 3.0)
|
|
(: I 1.)
|
|
DO-I-50
|
|
((LAMBDA (TEMP-VAL)
|
|
(COND ((MINUSP TEMP-VAL) (GO /50))
|
|
((ZEROP TEMP-VAL) (GO /60)) (T (GO /50))))
|
|
(BIGF (+$ (CHAIR I) (-$ (BIGF SJSTRT)))))
|
|
;;; GOLDILOCKS TRIED EACH OF THE THREE CHAIRS. PAPA BEAR'S WAS TOO BIG,
|
|
;;; MAMA BEAR'S WAS TOO SMALL, BUT BABY BEAR'S WAS JUST RIGHT. GOLDILOCKS
|
|
;;; SAT DOWN IN BABY BEAR'S CHAIR, BUT SHE WAS TOO HEAVY AND IT BROKE.
|
|
(GO /65)
|
|
/60 (: CHAIRB GOLDIE)
|
|
(: BROKEN 0.0)
|
|
/65 (: LVNGRM (FIX (+$ (FLOAT LVLGRM) (-$ GOLDIE))))
|
|
;;; THEEN SHE LEFT THE LIVING ROOM AND WENT INTO THE BEDROOM. THERE SHE
|
|
;;; FOUND THREE BEDS; PAPA BEAR'S, MAMA BEAR'S, AND BABY BEAR'S/
|
|
(: BEDRM GOLDIE)
|
|
(: BEDP 1.0)
|
|
(: BEDM 2.0)
|
|
(: BEDB 3.0)
|
|
(: I 1.)
|
|
DO-I-70
|
|
((LAMBDA (TEMP-VAL)
|
|
(COND ((MINUSP TEMP-VAL) (GO /70))
|
|
((ZEROP TEMP-VAL) (GO /80)) (T (GO /70))))
|
|
(+$ (HARDF (BED I)) (-$ (HARDF SJSTRT))))
|
|
/70 ;;; CONTINUE
|
|
(COND ((LE (: I (1+ I)) 3.) (GO DO-I-70)))
|
|
(GO /85)
|
|
;;; MEANWHILE... THE BEARS WERE RETURNING FROM THEIR WALK IN THE WOODS.
|
|
/80 (: BEDB GOLDIE)
|
|
/85 (FORTRAN-PAUSE)
|
|
;;; CONTINUE
|
|
(: I 1.)
|
|
DO-I-90
|
|
(: (WOODS2 (PLUS 101. (MINUS I))) PAPA)
|
|
(: (WOODS2 (PLUS 102. (MINUS I))) (FLOAT MAMA))
|
|
(: (WOODS2 (PLUS 103. (MINUS I))) BABY)
|
|
;;; THEY REACHED THE HOUSE AND WENT INTO THE KITCHAN AND LOOKED AT THEIR
|
|
;;; BOWLS OF PORRIDGE. PAPA BEAR SAID, "SOMEBODY'S BEEN EATING MY PORRIDG
|
|
;;; MAMA BEAR SAID, "SOMEBODY'S BEEN EATING MY PORRIDGE." BABY BEAR SAID,
|
|
;;; "SOMEBODY'S BEEN EATING MY PORRIDGE, AND HE ATE IT ALL UP!"
|
|
/90 (: (WOODS2 (PLUS 104. (MINUS I))) 0.0)
|
|
(COND ((LE (: I (1+ I)) 4.) (GO DO-I-90)))
|
|
(: KITCHN (FIX (+$ PAPA (FLOAT MAMA) BABY)))
|
|
(: I 1.)
|
|
DO-I-130
|
|
(FORTRAN-PRINT 6. STORY-FORMAT-100)
|
|
((LAMBDA (TEMP-VAL)
|
|
(COND ((MINUSP TEMP-VAL) (GO /130))
|
|
((ZEROP TEMP-VAL) (GO /110)) (T (GO /130)))) (+ I (- 3.)))
|
|
/110 (FORTRAN-PRINT 6. STORY-FORMAT-120)
|
|
;;; THEY LEFT THE KITCHEN AND WENT INTO THE LIVING ROOM.
|
|
/130 ;;; CONTINUE
|
|
(COND ((LE (: I (1+ I)) 3.) (GO DO-I-130)))
|
|
(: KITCHN
|
|
(FIX (+$ (FLOAT KITCHN) (-$ (+$ PAPA (FLOAT MAMA) BABY)))))
|
|
;;; THEY LOOKED AT THEIR CHAIRS. PAPA BEAR SAID, "SOMEBODY'S BEEN
|
|
;;; SITTING IN MY CHAIR." MAMA BEAR SAID, "SOMEBODY'S BEEN SITTING IN
|
|
;;; MY CHAIR." BABY BEAR SAID, "SOMEBODY'S BEEN SITTING IN MY CHAIR, AND
|
|
;;; HE BROKE IT!"
|
|
(: LVNGRM (FIX (+$ PAPA (FLOAT MAMA) BABY)))
|
|
(: I 1.)
|
|
DO-I-170
|
|
(FORTRAN-PRINT 6. STORY-FORMAT-140)
|
|
((LAMBDA (TEMP-VAL)
|
|
(COND ((MINUSP TEMP-VAL) (GO /170))
|
|
((ZEROP TEMP-VAL) (GO /150)) (T (GO /170)))) (+ I (- 3.)))
|
|
/150 (FORTRAN-PRINT 6. STORY-FORMAT-160)
|
|
;;; THEY LEFT THE LIVING ROOM AND WENT INTO THE BEDROOM.
|
|
/170 ;;; CONTINUE
|
|
(COND ((LE (: I (1+ I)) 3.) (GO DO-I-170)))
|
|
(: LVNGRM
|
|
(FIX (+$ (FLOAT LVNGRM) (-$ (+$ PAPA (FLOAT MAMA) BABY)))))
|
|
;;; THEY LOOKED AT THEIR BEDS. PAPA BEAR SAID, "SOMEBODY'S BEEN
|
|
;;; SLEEPING IN MY BED." MAMA BEAR SAID, "SOMEBODY'S BEEN SLEEPING
|
|
;;; IN MY BED." BABY BEAR SAID "SOMEBODY'S BEEN SLEEPING IN MY BEDC AND T
|
|
(: BEDRM (+$ PAPA (FLOAT MAMA) BABY))
|
|
(: I 1.)
|
|
DO-I-210
|
|
(FORTRAN-PRINT 6. STORY-FORMAT-180)
|
|
((LAMBDA (TEMP-VAL)
|
|
(COND ((MINUSP TEMP-VAL) (GO /210))
|
|
((ZEROP TEMP-VAL) (GO /190)) (T (GO /210)))) (+ I (- 3.)))
|
|
/190 (FORTRAN-PRINT 6. STORY-FORMAT-200)
|
|
;;; GOLDILOCKS WOKE UP, AND, SEEING THE BEARS, JUMPED THROUGH THE WINDOW
|
|
;;; AND RAN AWAY THROUGH THE WOODS TO HER HOME. THE END.
|
|
/210 ;;; CONTINUE
|
|
(COND ((LE (: I (1+ I)) 3.) (GO DO-I-210)))
|
|
(: I 2.)
|
|
DO-I-220
|
|
(: (WOODS1 (PLUS 102. (MINUS I))) GOLDIE)
|
|
/220 (: (WOODS2 (PLUS 100. (MINUS I))) 0.0)
|
|
(COND ((LE (: I (+ I 2.)) 100.) (GO DO-I-220)))
|
|
(RETURN T))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;; Translation of "HARDF" ;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(FORTRAN (HARDF BED)
|
|
(SUBROUTINE
|
|
(REAL HARDF BED))
|
|
;;; Subroutine HARDF(BED)
|
|
(: HARDF BED)
|
|
(RETURN T))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;; Translation of "BIGF" ;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(FORTRAN (BIGF CHAIR)
|
|
(SUBROUTINE
|
|
(REAL BIGF CHAIR))
|
|
;;; Subroutine BIGF(CHAIR)
|
|
(: BIGF CHAIR)
|
|
(RETURN T))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;; Translation of "HOTF" ;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|