Skip to content

Instantly share code, notes, and snippets.

@samthor

samthor/ARTS.PRG Secret

Created Oct 12, 2020
Embed
What would you like to do?
*SET KEY -1 TO FUN1
*SET KEY -2 TO FUN2
SET KEY -3 TO FUN3
SET KEY -4 TO FUN4
HELPNO=C0
NUM=X1
DO CASE
CASE VERSN=C0
VRSN=" T E S T D A T A "
CASE VERSN=C1
VRSN=" A N C I E N T A R T S "
CASE VERSN=C2
VRSN="C X X X U N A N T I Q U E S"
CASE VERSN=C3
VRSN=" J A Y ' S J U N Q U E "
CASE VERSN=C4
VRSN=" P E T E R ' S B O O K S "
CASE VERSN=C5
VRSN=" S A M ' S S T U F F "
OTHERWISE
VRSN='#### INVALID ### INVALID #####'
ENDCASE
ARCHOICE=C1
DO WHILE .T.
CLEAR
? '��������������������������������������������������������������������������������'
? '��������������������������������������������������������������������������������'
SET MESSAGE TO 24 CENTER
@C2 ,C5 PROMPT '1> Sales' MESSAGE 'Record sales, laybys and stock on hold.'
@C2 ,C15 PROMPT '2> Stock' MESSAGE 'Display and/or change stock information.'
@C2 ,C25 PROMPT '3> History' MESSAGE 'View sales history.'
@C2 ,37 PROMPT '4> Collect' MESSAGE 'Produce printed reports and lists.'
@C2 ,49 PROMPT '5> Clients' MESSAGE 'Record and view client information.'
@C2 ,61 PROMPT '6> Manage' MESSAGE 'Change set-up, re-index files, change postcodes etc.'
@C2 ,72 PROMPT 'Q> Quit' MESSAGE 'Exit to DOS.'
@C2 ,C0 PROMPT '' MESSAGE 'About Easy Arts, Historical periods'
@C2 ,C2 PROMPT '?' MESSAGE 'How to get help.'
@C0,C0 SAY VRSN
IF IMPRTR=YA
@C0,35 SAY 'Importer Costing'
ELSE
IF IMPRTR='O'
@C0,35 SAY 'On-cost Costing'
ELSE
@C0,35 SAY 'Standard Costing'
ENDIF
ENDIF
@C0,64 SAY SUBST(CDOW(DATE()),1,3)+'.'
@C0,69 SAY DATE() PICTURE 'E'
IF CLR=YA
DO CASE
CASE SCHM=X1
SET COLOR TO BG/B,B/W,B
CASE SCHM=X2
SET COLOR TO GR/G,W+/ ,G
CASE SCHM=X3
SET COLOR TO RB/B,B+/GR,B
ENDCASE
USE
ELSE
SET COLOR TO W/ , /W
ENDIF
@C9 ,C14 SAY ' ����� ����� ���� � � ����� ����� ������� ����� '
@C10,C14 SAY ' � � � � � � � � � � � � '
@C11,C14 SAY ' � � � � � � � � � � � � '
@C12,C14 SAY ' ���� ����� ���� ����� ����� ����� � ����� '
@C13,C14 SAY ' � � � � � � � � �� � � '
@C14,C14 SAY ' � � � � � � � � �� � � '
@C15,C14 SAY ' ����� � � ���� � � � � �� � ����� '
@C16,C14 SAY ' '
IF CLR=YA
DO CASE
CASE SCHM=X1
SET COLOR TO BG+/B,B/W,B
CASE SCHM=X2
SET COLOR TO GR+/G,W+/ ,G
CASE SCHM=X3
SET COLOR TO RB+/B,B+/GR,B
ENDCASE
USE
ELSE
SET COLOR TO W+/ , /W
ENDIF
MENU TO ARCHOICE
@C24,C0 CLEAR
IF ARCHOICE>C9
ARCHOICE=C7
ENDIF
DO CASE
CASE ARCHOICE=C1
DO ARTSSALE
CASE ARCHOICE=C2
DO ARTSEDIT
CASE ARCHOICE=C3
DO ARTSHIST
CASE ARCHOICE=C4
DO ARTSCOL
CASE ARCHOICE=C5
DO ARTSCLI
CASE ARCHOICE=C6
DO ARTSMAN
CASE ARCHOICE=C7 .OR. ARCHOICE=C0
@C24,C0 CLEAR
YORN=YA
CALL FADE
@C22,25 SAY '�����������������������������Ŀ'
@C23,25 SAY '� �'
@C24,25 SAY '�������������������������������'
@C23,27 SAY 'EXIT now?' GET YORN PICTURE '!'
READ
IF YORN=YA
USE
RETURN
ENDIF
CASE ARCHOICE=C8
@C24,C0 CLEAR
PICK=C1
CALL FADE
@C3 ,C0 SAY '�������������������������͸'
@C4 ,C0 SAY '� �'
@C5 ,C0 SAY '�������������������������Ĵ'
@C6 ,C0 SAY '� �'
@C7 ,C0 SAY '�������������������������Ĵ'
@C8 ,C0 SAY '� �'
@C9 ,C0 SAY '���������������������������'
SET MESSAGE TO 24 CENTER
@C4 ,C2 PROMPT '1> About Easy Arts' MESSAGE 'Sales information, version and copyright notice'
@C6 ,C2 PROMPT '2> Historical Periods' MESSAGE 'Historical and reign periods for antiques'
@C8 ,C2 PROMPT 'Q> Quit' MESSAGE 'Return to the main menu'
MENU TO CHOICE2
@C24,C0 CLEAR
DO CASE
CASE CHOICE2=C1
CALL FADE
@C7 ,C5 SAY '����������������������������������������������������������������������ͻ'
@C8 ,C5 SAY '� EASY ARTS Version 2.0, 1993 �'
@C9 ,C5 SAY '� �'
@C10,C5 SAY '� This software and associated materials is COPYRIGHT to Easy Soft. �'
@C11,C5 SAY '� �'
@C12,C5 SAY '� The software has been provided under a license for use on a single �'
@C13,C5 SAY '� (or subsequent) computer. THE SOFTWARE MAY NOT BE ALTERED OR COPIED �'
@C14,C5 SAY '� other than for retention by the licensee as a security backup. �'
@C15,C5 SAY '� Violation can result in criminal prosecution. �'
@C16,C5 SAY '� �'
@C17,C5 SAY '� Sales enquiries should be directed to �'
@C18,C5 SAY '� Coastal Business Computers �'
@C19,C5 SAY '� Phone (xx) xxxx xxxx. �'
@C20,C5 SAY '����������������������������������������������������������������������ͼ'
ANY=' '
@C22,C20 SAY 'Any key to continue' GET ANY
READ
CASE CHOICE2=C2
SAVE SCREEN TO SCRN1
PICK=C1
CALL FADE
@C3 ,C0 SAY '�������������������������͸'
@C4 ,C0 SAY '� �'
@C5 ,C0 SAY '� �'
@C6 ,C0 SAY '� �'
@C7 ,C0 SAY '�������������������������Ĵ'
@C8 ,C0 SAY '� �'
@C9 ,C0 SAY '���������������������������'
@C4 ,C2 PROMPT '1> European Periods'
@C5 ,C2 PROMPT '2> Asian Periods'
@C6 ,C2 PROMPT '3> Egyptian Dynasties'
@C8 ,C2 PROMPT 'Q> Quit'
MENU TO PICK
DO CASE
CASE PICK=C1
CALL FADE
@C5 ,C0 SAY '������������������������������������������������������������������������������Ŀ'
@C6 ,C0 SAY '� EUROPEAN PERIODS �'
@C7 ,C0 SAY '������������������������������������������������������������������������������Ĵ'
@C8 ,C0 SAY '� � GREECE: � ENGLAND: �'
@C9 ,C0 SAY '� 1st Byzantine 528-622 � Archaic 700-480 BC � Elizabethan 1558-1603 �'
@C10,C0 SAY '� 2nd Byzantine 800-1105 � Classical 480=323 BC � Jacobean 1603-1625 �'
@C11,C0 SAY '� Romanesque 1000-1140 � Helenic 323-30 BC � Carolean 1625-1649 �'
@C12,C0 SAY '� Gothic 1140-1500 �������������������������Ĵ Cromwellian 1649-1660 �'
@C13,C0 SAY '� Renaisance 1400-1600 � ROME: � Restoration 1660=1699 �'
@C14,C0 SAY '� Baroque 1600-1700 � Republic 508 BC-27 AD � William & Mary 1688-1702 �'
@C15,C0 SAY '� Rococo 1700-1790 � Imperial 27-295 � Queen Anne 1702-1714 �'
@C16,C0 SAY '� Regency 1811-1830 �������������������������Ĵ Georgian 1714-1811 �'
@C17,C0 SAY '� Victorian 1837-1901 � FRANCE: � Regency 1811-1830 �'
@C18,C0 SAY '� Art Noveau 1895-1919 � Louis XIV 1643-1715 � William IV 1830-1837 �'
@C19,C0 SAY '� Art Deco 1920-1939 � Louis XV 1723-1774 � Victorian 1937-1901 �'
@C20,C0 SAY '� � Louis XVI 1774-1793 � Edwardian 1901-1910 �'
@C21,C0 SAY '��������������������������������������������������������������������������������'
WAIT
CASE PICK=C2
CALL FADE
@C1 ,C0 SAY '������������������������������������������������������������������������������Ŀ'
@C2 ,C0 SAY '� ASIAN PERIODS �'
@C3 ,C0 SAY '������������������������������������������������������������������������������Ĵ'
@C4 ,C0 SAY '� CHINA: � INDIA: � JAPAN: �'
@C5 ,C0 SAY '� � Maurya 332-185 BC � Asoka 522-645 �'
@C6 ,C0 SAY '� � Sunga 185-70 BC � Nara 645-794 �'
@C7 ,C0 SAY '� � Kushan 30 BC-320 AD � Jogan 794-897 �'
@C8 ,C0 SAY '� � Gupta 320-600 AD � Fujiwara 897-1185 �'
@C9 ,C0 SAY '� � Hindu 750-1000 AD � Kamakura 1185-1392 �'
@C10,C0 SAY '� � Chola 846-1173 AD � Ashikaga 1392-1573 �'
@C11,C0 SAY '� � Moslem 1000-1736 AD � Momoyama 1513-1615 �'
@C12,C0 SAY '� ������������������������Ĵ Tokugawa 1615-1868 �'
@C13,C0 SAY '� � THAILAND: � �'
@C14,C0 SAY '� � Dvaravati 600-1100 ����������������������Ĵ'
@C15,C0 SAY '� � Srivijaya 800-1300 � KOREA: �'
@C16,C0 SAY '� � Lop Buri 1000-1400 � Three Kingdoms �'
@C17,C0 SAY '� � Sukhothai 1300-1500 � 57 BC-935 AD �'
@C18,C0 SAY '� � Ayutthaya 1350-1767 � Koryo 910-1392 �'
@C19,C0 SAY '� � Thon Buri 1767-1782 � Choson 1392-1910 �'
@C20,C0 SAY '� � Bangkok 1782- � Republic 1948- �'
@C21,C0 SAY '��������������������������������������������������������������������������������'
@C22,C20 SAY 'Select * entries for more detail'
@C5 ,C2 PROMPT 'Shang 1523-1028 BC'
@C6 ,C2 PROMPT 'Chou 1028-252 BC'
@C7 ,C2 PROMPT 'Chin 221-207 BC'
@C8 ,C2 PROMPT 'Han 207 BC-220 AD'
@C9 ,C2 PROMPT 'Northern & Southern 220-581'
@C10,C2 PROMPT 'Sui 581-618'
@C11,C2 PROMPT 'Tang 618-906'
@C12,C2 PROMPT 'Five Dynasties 907-960'
@C13,C2 PROMPT 'Northern Sung 980-1126'
@C14,C2 PROMPT 'Southern Sung 1127-1279'
@C15,C2 PROMPT 'Yuan 1279-1368'
@C16,C2 PROMPT 'Ming 1368-1644*'
@C17,C2 PROMPT "Ch'ing 1600-1910*"
@C18,C2 PROMPT 'Republic 1910- '
MENU TO PICK2
DO CASE
CASE PICK2=C12
CALL FADE
@C9 ,34 SAY '��������������������������������������������Ŀ'
@C10,34 SAY '� MING REIGN PERIODS �'
@C11,34 SAY '��������������������������������������������Ĵ'
@C12,34 SAY '� Hongwu 1368-1398 � Hongzhi 1488-1505 �'
@C13,34 SAY '� Jianwen 1399-1402 � Zhengde 1506-1521 �'
@C14,34 SAY '� Yongle 1403-1424 � Jiangjing 1522-1566 �'
@C15,34 SAY '� Hongxi 1425 � Longqing 1567-1572 �'
@C16,34 SAY '� Xuande 1426-1435 � Wanli 1573-1620 �'
@C17,34 SAY '� Zhangtong 1436-1449 � Taichang 1620 �'
@C18,34 SAY '� Jingtai 1450-1456 � Tianqi 1621-1627 �'
@C19,34 SAY '� Tianshun 1457-1464 � Chongzhen 1628-1644 �'
@C20,34 SAY '� Chenghua 1465-1487 � �'
@C21,34 SAY '����������������������������������������������'
WAIT
CASE PICK2=C13
CALL FADE
@C8 ,40 SAY '����������������������Ŀ'
@C9 ,40 SAY '� CHING REIGN PERIODS �'
@C10,40 SAY '����������������������Ĵ'
@C11,40 SAY '� Shunzhi 1644-1661 �'
@C12,40 SAY '� Kangxi 1662-1722 �'
@C13,40 SAY '� Yongzheng 1722-1735 �'
@C14,40 SAY '� Qianlong 1736-1795 �'
@C15,40 SAY '� Jiaqing 1796-1820 �'
@C16,40 SAY '� Daoguang 1821-1850 �'
@C17,40 SAY '� Xianfeng 1851-1861 �'
@C18,40 SAY '� Tangzhi 1862-1874 �'
@C19,40 SAY '� Guangzu 1875-1908 �'
@C20,40 SAY '� Xuantong 1909-1912 �'
@C21,40 SAY '������������������������'
WAIT
ENDCASE
CASE PICK=C3
CALL FADE
@C8 ,40 SAY '������������������������������Ŀ'
@C9 ,40 SAY '� EGYPTIAN DYNASTIES �'
@C10,40 SAY '������������������������������Ĵ'
@C11,40 SAY '� Early Dynasties 3000-2500 BC �'
@C12,40 SAY '� Old Kingdom 2686-2191 BC �'
@C13,40 SAY '� Middle Kingdom 2133-1750 BC �'
@C14,40 SAY '� New Kiingdom 1570-1070 BC �'
@C15,40 SAY '� Late Period 716-332 BC �'
@C16,40 SAY '� Ptolemaic 332-30 BC �'
@C17,40 SAY '��������������������������������'
WAIT
ENDCASE
RESTORE SCREEN FROM SCRN1
CALL FADE
CASE CHOICE2=C0
LOOP
ENDCASE CHOICE2
CASE ARCHOICE=C9
ANY=' '
CALL FADE
@C18,C20 SAY '������������������������������������������ͻ'
@C19,C20 SAY '� Press F1 for on-screen help at any time.�'
@C20,C20 SAY '� If, after consulting your manual, �'
@C21,C20 SAY '� you need further help, call Coastal �'
@C22,C20 SAY '� Business Computers on (xx) xxxx xxxx. �'
@C23,C20 SAY '� Any key to continue. �'
@C24,C20 SAY '������������������������������������������ͼ'
@C23,53 GET ANY
READ
ENDCASE ARCHOICE
ENDDO
*
PROCEDURE FUN5
SAVE SCREEN
CALL FADE
@C19,C18 SAY '���������������������Ŀ'
@C20,C18 SAY '� �'
@C21,C18 SAY '�����������������������'
DO WHILE .T.
OPER=' '
@C19,42 SAY '�����������������Ŀ'
@C20,42 SAY '� �'
@C21,42 SAY '�������������������'
@C20,C20 PROMPT STR(X,19,9)
@C20,44 PROMPT '+'
@C20,46 PROMPT '-'
@C20,48 PROMPT 'x'
@C20,50 PROMPT CHR(246)
@C20,52 PROMPT CHR(251)
@C20,54 PROMPT CHR(241)
@C20,56 PROMPT 'C'
@C20,58 PROMPT '='
MENU TO PICK
READ
DO CASE
CASE PICK=C1
@C20,C20 GET X PICTURE '999999999.999999999'
READ
CASE PICK=C2
Y=X
@C20,C20 GET Y PICTURE '999999999.999999999'
READ
X=X+Y
Z=X
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C3
Y=X
@C20,C20 GET Y PICTURE '999999999.999999999'
READ
X=X-Y
Z=X
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C4
Y=X
@C20,C20 GET Y PICTURE '999999999.999999999'
READ
X=X*Y
Z=X
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C5
Y=X
@C20,C20 GET Y PICTURE '999999999.999999999'
READ
X=X/Y
Z=X
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C6
Y=X
@C20,C20 GET Y PICTURE '999999999.999999999'
READ
X=SQRT(Y)
Z=X
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C7
Y=X
@C20,C20 GET Y PICTURE '999999999.999999999'
READ
X=-Y
Z=X
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C8
X=C0
Y=C0
Z=C0
@C20,C20 SAY SPACE(19)
@C20,C20 SAY X PICTURE '999999999.999999999'
CASE PICK=C9
EXIT
ENDCASE
ENDDO
RESTORE SCREEN
RETURN
*
PROCEDURE FUN3
SAVE SCREEN
CALL FADE
@C13,28 SAY '����������������������������������Ŀ'
@C14,28 SAY '� �'
@C15,28 SAY '� �'
@C16,28 SAY '� �'
@C17,28 SAY '� �'
@C18,28 SAY '� �'
@C19,28 SAY '������������������������������������'
@C14,30 PROMPT '1> Convert from $US'
@C15,30 PROMPT '2> Convert from $HK'
@C16,30 PROMPT '3> Convert from Yen'
@C17,30 PROMPT '4> Convert from Pounds'
@C18,30 PROMPT '5> Convert from another currency'
MENU TO PICK
AMNT1=C0
AMNT2=C0
READ
@C19,28 SAY '������������������������������������Ŀ'
@C20,28 SAY '� �'
@C21,28 SAY '��������������������������������������'
DO CASE
CASE PICK=C1
@C20,30 SAY '$US:' GET AMNT1 PICTURE '9999999.99'
READ
AMNT2=AMNT1/USRATE
CASE PICK=C2
@C20,30 SAY '$HK:' GET AMNT1 PICTURE '9999999.99'
READ
AMNT2=AMNT1/HKRATE
CASE PICK=C3
@C20,30 SAY ' Y:' GET AMNT1 PICTURE '999999999.99'
READ
AMNT2=AMNT1/JAPRATE
CASE PICK=C4
@C20,30 SAY 'Pnd:' GET AMNT1 PICTURE '9999999.99'
READ
AMNT2=AMNT1/UKRATE
CASE PICK=C5
@C20,30 SAY ' #:' GET AMNT1 PICTURE '999999999.99'
READ
AMNT2=AMNT1/OTRATE
ENDCASE
@C20,49 SAY '$A'
@C20,52 SAY AMNT2 PICTURE '@B 999999999.99'
WAIT
RESTORE SCREEN
RETURN
*
PROCEDURE FUN4
SAVE SCREEN
CALL FADE
AMNT2=C0
@C17,C20 SAY '��������������������������������Ŀ'
@C18,C20 SAY '� Convert to foreign currencies: �'
@C19,C20 SAY '� $A: �'
@C20,C20 SAY '����������������������������������'
@C19,26 GET AMNT2 PICTURE '9999999.99'
READ
AMNTUS=AMNT2*USRATE
AMNTHK=AMNT2*HKRATE
AMNTJAP=AMNT2*JAPRATE
AMNTUK=AMNT2*UKRATE
AMNTOT=AMNT2*OTRATE
@C14,58 SAY '������������������Ŀ'
@C15,58 SAY '� �'
@C16,58 SAY '� �'
@C17,58 SAY '� �'
@C18,58 SAY '� �'
@C19,58 SAY '� �'
@C20,58 SAY '��������������������'
@C15,60 SAY '$US '
@C15,64 SAY AMNTUS PICTURE '@B 999999999.99'
@C16,60 SAY '$HK '
@C16,64 SAY AMNTHK PICTURE '@B 999999999.99'
@C17,60 SAY '� '
@C17,64 SAY AMNTJAP PICTURE '@B 999999999.99'
@C18,60 SAY '� '
@C18,64 SAY AMNTUK PICTURE '@B 999999999.99'
@C19,60 SAY '# '
@C19,64 SAY AMNTOT PICTURE '@B 999999999.99'
@C21,C0
WAIT
RESTORE SCREEN
RETURN
*
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.