|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8320 (0x2080)
Types: TextFile
Names: »BIOMO.PAS«
└─⟦dd59903ef⟧ Bits:30005887 Klub diskette for udveksling af software
└─ ⟦this⟧ »BIOMO.PAS«
program biograf; const phys = 'P'; emot = 'E'; intl = 'I'; resl = '*'; pi = 3.14159265; blank = ' '; dash = '-'; var cyp, cye, cyi, lida: real; xa, ya, pval, eval, ival, nval, cmn, cmd: integer; pgs, wks, ndt, cyr, byr, cmo, bmo, bda: integer; cda, hrs, adj, stl, ttl, ayr, amo, ada: integer; printvar, ans: char; name: array Æ1..30Å of char; add1: array Æ1..30Å of char; add2: array Æ1..30Å of char; add3: array Æ1..30Å of char; print: text; begin writeln( 'THIS PROGRAM COMPUTES AND PRINTS BIOGRAFS FOR A'); writeln( ' MONTHLY PERIOD.......READY? (Y/N)'); read(ans); while ans = 'Y' do begin writeln( 'ENTER NAME & ADDRESS....(use 4 lines)' ); read (name); read (add1); read (add2); read (add3); writeln( 'ENTER DATE & HOUR OF BIRTH....(use 24 hour clock) '); read (bmo, bda, byr, hrs); case bmo of 1 : bmo := 0; 2 : bmo := 31; 3 : bmo := 59; 4 : bmo := 90; 5 : bmo := 120; 6 : bmo := 151; 7 : bmo := 181; 8 : bmo := 212; 9 : bmo := 243; 10 : bmo := 273; 11 : bmo := 304; 12 : bmo := 334; end; writeln( 'ENTER DATE DESIRED FOR START OF BIORYTHMN....' ); read (cmo, cda, cyr); cda := 1; writeln( 'ENTER NUMBER OF MONTHLY CHARTS WANTED.. THEN,'); writeln( 'TOGGLE PRINTER ''ON'' ... THEN HIT RETURN KEY.'); read(wks); for pgs := wks downto 1 do begin cmn := cmo; cmd := cmo; case cmo of 1 : cmo := 0; 2 : cmo := 31; 3 : cmo := 59; 4 : cmo := 90; 5 : cmo := 120; 6 : cmo := 151; 7 : cmo := 181; 8 : cmo := 212; 9 : cmo := 243; 10 : cmo := 273; 11 : cmo := 304; 12 : cmo := 334; end; case cmd of 2 : cmd := 28; 4 : cmd := 30; 6 : cmd := 30; 9 : cmd := 30; 11 : cmd := 30; else : cmd := 31; end; ayr := (cyr - byr) * 365; amo := (cmo - bmo); ada := (cda - bda); stl := ayr + amo + ada; adj := round((stl - 183)/1460); ttl := stl + adj; lida := ttl - 0.125 + (hrs/24); rewrite( 'lst:', print); write( print, chr(17)); writeln; write( 'BIO-GRAF BIO-GRAF BIO-GRAF BIO-GRAF '); writeln( 'BIO-GRAF BIO-GRAF BIO-GRAF BIO-GRAF BIO-GRAF'); writeln; writeln; writeln( ' THIS' ); writeln( ' BIO-GRAF' ); writeln( ' COMPUTED' ); writeln( ' ESPECIALLY' ); writeln( ' FOR YOU,' ); writeln; writeln; writeln; writeln; rewrite( 'lst:', print); write( print, chr(27)); write( print, chr(52)); writeln( ' ', name); writeln; writeln( ' ', add1); writeln( ' ', add2); writeln( ' ', add3); writeln; rewrite( 'lst:', print); write( print, chr(27)); write( print, chr(53)); writeln; writeln; writeln; write( print, chr(14)); writeln( ' THIS IS YOUR BIO-GRAF FOR THE MONTH OF'); writeln; write( print, chr(14)); case cmn of 1 : write( 'JANUARY':20); 2 : write( 'FEBRUARY':20); 3 : write( 'MARCH':20); 4 : write( 'APRIL':20); 5 : write( 'MAY':20); 6 : write( 'JUNE':20); 7 : write( 'JULY':20); 8 : write( 'AUGUST':20); 9 : write( 'SEPTEMBER':20); 10 : write( 'OCTOBER':20); 11 : write( 'NOVEMBER':20); 12 : write( 'DECEMBER':20); end; writeln( ' ', cyr:0); writeln; cyp := lida/23 - trunc(lida/23); cye := lida/28 - trunc(lida/28); cyi := lida/33 - trunc(lida/33); rewrite( 'lst:', print); write( print, chr(27)); write( print, chr(48)); if cmd = 31 then write( ' ':10, '1':20); if cmd = 31 then writeln( ' 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3'); if cmd = 31 then write( ' ':10, ' 1 2 3 4 5 6 7 8 9 0'); if cmd = 31 then writeln( ' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1'); if cmd = 30 then write( ' ':10, '1':20); if cmd = 30 then writeln( ' 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3'); if cmd = 30 then write( ' ':10, ' 1 2 3 4 5 6 7 8 9 0'); if cmd = 30 then writeln( ' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0'); if cmd = 28 then write( ' ':10, '1':20); if cmd = 28 then writeln( ' 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2'); if cmd = 28 then write( ' ':10, ' 1 2 3 4 5 6 7 8 9 0'); if cmd = 28 then writeln( ' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8'); cmd := (cmd * 2) + 2; for ya := 20 downto 1 do begin write((ya * 5):8, ' '); for xa := 0 to cmd do begin pval := round(sin((cyp + (xa/46)) * 2 * pi) * 20); eval := round(sin((cye + (xa/56)) * 2 * pi) * 20); ival := round(sin((cyi + (xa/66)) * 2 * pi) * 20); nval := round((pval + eval + ival) div 3); if pval = ya then printvar := phys; if eval = ya then printvar := emot; if ival = ya then printvar := intl; if (pval = ya) and (eval = ya) then printvar := '2'; if (pval = ya) and (ival = ya) then printvar := '2'; if (eval = ya) and (ival = ya) then printvar := '2'; if nval = ya then printvar := resl; if (nval <> ya) and (pval <> ya) and (eval <> ya) and (ival <> ya) then printvar := blank; if (xa = 0) or (xa = cmd) then printvar := 'ø'; write(printvar); end; writeln((ya * 5): 4); end; write( 'CRITICAL': 5, ' '); for xa := 0 to cmd do begin pval := round(sin((cyp + (xa/46)) * 2 * pi) * 20); eval := round(sin((cye + (xa/56)) * 2 * pi) * 20); ival := round(sin((cyi + (xa/66)) * 2 * pi) * 20); nval := round((pval + eval + ival) div 3); if (nval = 0) then printvar := resl; if (pval = 0) or (eval = 0) or (ival = 0) then printvar := 'C'; if (pval <> 0) and (eval <> 0) and (ival <> 0) and (nval <> 0) then printvar := dash; if (xa = 0) or (xa = cmd) then printvar := '0'; write(printvar); end; writeln; for ya := 1 to 20 do begin write((ya * 5):8, ' '); for xa := 0 to cmd do begin pval := round(sin((cyp + (xa/46)) * 2 * pi) * 20); eval := round(sin((cye + (xa/56)) * 2 * pi) * 20); ival := round(sin((cyi + (xa/66)) * 2 * pi) * 20); nval := round((pval + eval + ival) div 3); if pval = (-ya) then printvar := phys; if eval = (-ya) then printvar := emot; if ival = (-ya) then printvar := intl; if (pval = (-ya)) and (eval = (-ya)) then printvar := '2'; if (pval = (-ya)) and (ival = (-ya)) then printvar := '2'; if (eval = (-ya)) and (ival = (-ya)) then printvar := '2'; if nval = (-ya) then printvar := resl; if (nval <> -ya) and (pval <> -ya) and (eval <> -ya) and (ival <> -ya) then printvar := blank; if (xa = 0) or (xa = cmd) then printvar := 'ø'; write(printvar); end; writeln((ya * 5): 4); end; cmd := (cmd - 2) div 2; if cmd = 31 then write( ' ':10, '1':20); if cmd = 31 then writeln( ' 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3'); if cmd = 31 then write( ' ':10, ' 1 2 3 4 5 6 7 8 9 0'); if cmd = 31 then writeln( ' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1'); if cmd = 30 then write( ' ':10, '1':20); if cmd = 30 then writeln( ' 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3'); if cmd = 30 then write( ' ':10, ' 1 2 3 4 5 6 7 8 9 0'); if cmd = 30 then writeln( ' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0'); if cmd = 28 then write( ' ':10, '1':20); if cmd = 28 then writeln( ' 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 '); if cmd = 28 then write( ' ':10, ' 1 2 3 4 5 6 7 8 9 0'); if cmd = 28 then writeln( ' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 '); writeln; writeln; writeln; rewrite( 'lst:', print); write( print, chr(27)); write( print, chr(50)); write( 'BIO-GRAF BIO-GRAF BIO-GRAF BIO-GRAF BIO-GRAF '); writeln( 'BIO-GRAF BIO-GRAF BIO-GRAF BIO-GRAF'); writeln; writeln; writeln; ndt := cmo + cda + 31; if (ndt <32) and (ndt >0) then cmo := 1; if (ndt <60) and (ndt >31) then cmo := 2; if (ndt <91) and (ndt >59) then cmo := 3; if (ndt <121) and (ndt >90) then cmo := 4; if (ndt <152) and (ndt >120) then cmo := 5; if (ndt <182) and (ndt >151) then cmo := 6; if (ndt <213) and (ndt >181) then cmo := 7; if (ndt <244) and (ndt >212) then cmo := 8; if (ndt <274) and (ndt >243) then cmo := 9; if (ndt <305) and (ndt >273) then cmo := 10; if (ndt <335) and (ndt >304) then cmo := 11; if (ndt <366) and (ndt >334) then cmo := 12; if (ndt <400) and (ndt >365) then cmo := 1; if (ndt <400) and (ndt >365) then cyr := cyr + 1; end; rewrite( 'lst:', print); write( print, chr(19)); writeln( 'MORE TO DO?'); read(ans); end; end. «eof»