home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / amiga_e-2.1b.lha / Amiga_E-2.1b / Sources / Other / Pyth.e < prev    next >
Encoding:
Text File  |  1993-10-05  |  3.5 KB  |  106 lines
  1. /*
  2.     This is the E version of the 'Tree of Pythagoras'.
  3.     Written by Raymond Hoving, Waardgracht 30, 2312 RP Leiden,
  4.     The Netherlands.
  5.     Requires Kickstart V2.04+ and reqtools.library V37+
  6.     This version uses the mathffp.library/SpXxx functions for float
  7.     calculations.
  8.     Creation date: Sun Jan  3 18:43:34 1993, Version: 1.0
  9. */
  10.  
  11. OPT    STACK=25000    /* Just to be sure (we use a recursive algorithm). */
  12. OPT    OSVERSION=37    /* Kickstart 2.04+ only. */
  13.  
  14. MODULE    'intuition/intuition', 'intuition/screens', 'utility/tagitem',
  15.     'reqtools', 'graphics/displayinfo', 'exec/ports', 'exec/libraries',
  16.     'libraries/reqtools'
  17.  
  18. DEF    pythscreen=NIL : PTR TO screen,
  19.     pythwindow=NIL : PTR TO window,
  20.     pythidcmp=NIL : PTR TO mp,
  21.     depth=1, mdepth=10 : LONG
  22.             
  23. ENUM    MSG_READY, MSG_ABORT, ERROR_REQTLIB, ERROR_SCREEN, ERROR_WINDOW
  24.  
  25. PROC     pythcleanup(errornumber)
  26.     IF pythwindow<>NIL THEN CloseWindow(pythwindow)
  27.     IF pythscreen<>NIL THEN CloseScreen(pythscreen)
  28.     IF reqtoolsbase<>NIL THEN CloseLibrary(reqtoolsbase)
  29.     SELECT    errornumber
  30.         CASE ERROR_REQTLIB
  31.             WriteF('ERROR: Couldn\at open reqtools.library.\n')
  32.         CASE ERROR_SCREEN
  33.             WriteF('ERROR: Couldn\at open new screen.\n')
  34.         CASE ERROR_WINDOW
  35.             WriteF('ERROR: Couldn\at open new window.\n')
  36.         CASE MSG_ABORT
  37.             WriteF('***Break\n')
  38.         CASE MSG_READY
  39.             WriteF('I just drew \d little house\s!\n',
  40.                 Shl(1,mdepth)-1,
  41.                 IF mdepth=1 THEN '' ELSE 's')
  42.     ENDSELECT
  43.     CleanUp(errornumber)
  44. ENDPROC
  45.  
  46. PROC    pythtree(a1,a2,b1,b2)
  47.     DEF    c1,c2,d1,d2,e1,e2,    /* We use the LONG type */
  48.         ci1,ci2,di1,di2 : LONG    /* to hold FFP float numbers! */
  49.                 /* Check for the close gadget. */
  50.     IF GetMsg(pythidcmp)<>NIL THEN pythcleanup(MSG_ABORT)
  51.     IF depth<=mdepth
  52.         INC depth
  53.         SetAPen(stdrast,depth)
  54.          c1 := SpAdd(SpSub(a2,a1),b2) ; ci1 := SpFix(c1)
  55.         c2 := SpSub(b1,SpAdd(a1,a2)) ; ci2 := SpFix(c2)    
  56.         d1 := SpSub(a2,SpAdd(b1,b2)) ; di1 := SpFix(d1)
  57.         d2 := SpAdd(SpSub(b1,a1),b2) ; di2 := SpFix(d2)
  58.                     /* Calculate the new points. */
  59.         e1 := SpMul(0.5,SpAdd(SpAdd(SpSub(c2,c1),d1),d2))
  60.         e2 := SpMul(0.5,SpAdd(SpSub(d1,SpAdd(c1,c2)),d2))
  61.         Move(stdrast,ci1,ci2)
  62.         Draw(stdrast,SpFix(a1),SpFix(a2))
  63.         Draw(stdrast,SpFix(b1),SpFix(b2))
  64.         Draw(stdrast,di1,di2)
  65.         Draw(stdrast,ci1,ci2)
  66.         Draw(stdrast,SpFix(e1),SpFix(e2))
  67.         Draw(stdrast,di1,di2)    /* Draw the little house. */
  68.         pythtree(c1,c2,e1,e2)
  69.         pythtree(e1,e2,d1,d2)    /* Recursive procedure calls. */
  70.         DEC depth
  71.     ENDIF
  72. ENDPROC
  73.  
  74. PROC    main()
  75.     IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN pythcleanup(ERROR_REQTLIB)
  76.     IF (RtGetLongA({mdepth},'Tree in E needs input...',NIL,
  77.         [RTGL_MIN,1,
  78.         RTGL_MAX,14,
  79.         RTGL_TEXTFMT,'Enter maximum depth of the tree:',
  80.         RT_WINDOW,pythwindow,
  81.         TAG_DONE,TAG_DONE]))=FALSE THEN pythcleanup(MSG_ABORT)
  82.     IF (pythscreen:=OpenScreenTagList(NIL,    [SA_WIDTH,640,
  83.         SA_HEIGHT,400,
  84.         SA_DEPTH,4,
  85.         SA_TYPE,CUSTOMSCREEN,
  86.         SA_DISPLAYID,DEFAULT_MONITOR_ID OR HIRESLACE_KEY,
  87.         SA_TITLE,'Screen of Pythagoras',
  88.         TAG_DONE,TAG_DONE]))=NIL THEN pythcleanup(ERROR_SCREEN)
  89.     IF (pythwindow:=OpenWindowTagList(NIL,    [WA_TOP,1,
  90.         WA_WIDTH,640,
  91.         WA_HEIGHT,399,
  92.         WA_IDCMP,IDCMP_CLOSEWINDOW,
  93.         WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_ACTIVATE,
  94.         WA_TITLE,'Tree of Pythagoras by Raymond Hoving',
  95.         WA_CUSTOMSCREEN,pythscreen,
  96.         TAG_DONE,TAG_DONE]))=NIL THEN pythcleanup(ERROR_WINDOW)
  97.     LoadRGB4(ViewPortAddress(pythwindow), [$000,$89a,$640,
  98.         $752,$762,$771,$781,$680,$580,$080,$090,$0a0,
  99.         $0b0,$0c0,$0d0,$0e0] : INT, 16)
  100.     stdrast:=pythwindow.rport
  101.     pythidcmp:=pythwindow.userport
  102.     pythtree(SpFlt(273),SpFlt(394),SpFlt(367),SpFlt(394)) /* Go for it! */
  103.     WaitPort(pythidcmp)
  104.     pythcleanup(MSG_READY)
  105. ENDPROC
  106.