home *** CD-ROM | disk | FTP | other *** search
AmigaBASIC Source Code | 1988-01-19 | 14.5 KB | 279 lines |
- '###########################################################################
- '# #
- '# D X C C Personal Statistic Keeper #
- '# by #
- '# Bj. Madsen -+- VE5FX #
- '# Feb. 1987 #
- '# #
- '###########################################################################
- '
- 'This program is designed to keep track of your personal DXCC data, and will
- 'allow you to make displays or printouts formatted in a viriety of ways.
- '
- ' IMPORTANT VARIABLES:
- ' P$ = Prefix of country C$ = Name of country
- ' CS$ = Callsign worked S$ = Status (wrk./conf.)
- '
- CLEAR 500 : MYCALL$ = "VE5FX"
- DIM CS$(330) : DIM S$(330) : SET = 0 'SET - have we current date?
- LET N = 316 'set value of N to number of countries
- '
- '---------------------------------------------------------------- Show.Menu
- SHOWMENU:
- CLS:M$ = MYCALL$ + " - DXCC Statistics ":GOSUB BORDERS
- LOCATE 9,25: PRINT "1. Enter a new country."
- LOCATE 10,25: PRINT "2. List all DXCC data."
- LOCATE 11,25: PRINT "3. List countries worked."
- LOCATE 12,25: PRINT "4. List all countries needed."
- LOCATE 13,25: PRINT "5. Show statistics only."
- LOCATE 14,25: PRINT "6. Load data file from disk."
- LOCATE 15,25: PRINT "7. Save data file to disk."
- LOCATE 16,25: PRINT "8. End program."
- LOCATE 20,20: INPUT"What is your choice ....";C
- ON C GOSUB ENTERIT,LISTALL,LISTALL,LISTALL,LISTSTAT,LOADIT,SAVEIT,ENDIT
- GOTO SHOWMENU
- '---------------------------------------------------------------- Enter.It
- ENTERIT:
- IF SET=0 THEN GOSUB GETDATE: CHANGEDIT = 1
- M$ = MYCALL$ + " - ENTER A NEW DXCC CONTACT: ":GOSUB BORDERS:LINE(50,67)-(550,82),3,B
- LOCATE 10,15:INPUT"What is the callsign";CS$ : COLOR 1,0
- FOR L = 2 TO LEN(CS$)
- IF ASC(MID$(CS$,L,1)) < 58 THEN P = L - 1 'find position of number
- NEXT L
- RESTORE : X = 0
- READIT:
- READ P$,C$ : X = X+1 : FLAG = 1
- IF P$ = "END" THEN NOTFOUND
- IF LEFT$(P$,P) = LEFT$(CS$,P) THEN SHOWIT
- GOTO READIT
- SHOWIT:
- LINE (50,125)-(550,145),3,B: GOSUB BIGWIPE
- LOCATE 17,15: PRINT "Found: ";P$;" is the prefix for ";C$
- IF CS$(X) = "" THEN M$ = "[No callsign Currently ON file]" :ELSE M$ = "[Currently ON file is: "+CS$(X)+"]"
- LOCATE 18,20 : PRINT M$
- GOSUB WIPE: LOCATE 10,15: PRINT "Do you want to <S>ave ";CS$;" or <P>ass";
- GETKEY:
- A$=INKEY$
- IF A$ = "S" THEN CS$(X) = CS$ : GOTO QSL
- IF A$ = "P" AND FLAG = 1 THEN READIT
- IF A$ = "P" AND FLAG = 2 THEN READAGN
- GOTO GETKEY
- QSL:
- GOSUB WIPE:LOCATE 10,15:PRINT "Has ";CS$;" been confirmed <Y>es or <N>o?";
- GETQSL:
- A$=INKEY$
- IF A$ = "Y" THEN S$(X) = "o.k." : GOTO DONE
- IF A$ = "N" THEN S$(X) = "?" : GOTO DONE
- GOTO GETQSL
- NOTFOUND:
- LINE (50,125)-(550,145),3,B
- GOSUB BIGWIPE: LOCATE 17,15: PRINT "The prefix ";LEFT$(CS$,P);" is not on file."
- GOSUB WIPE: LOCATE 10,15: INPUT"What is the name of the country";CN$
- RESTORE : X = 0
- READAGN:
- READ P$,C$: X = X+1: FLAG = 2 'read prefix & country name
- IF C$ = "END" THEN CANTFIND
- IF LEFT$(C$,4) = LEFT$(CN$,4) THEN SHOWIT
- GOTO READAGN
- CANTFIND:
- GOSUB WIPE: LOCATE 10,15: PRINT "You will have to enter ";CS$;" the hard way"
- GOSUB BIGWIPE :LOCATE 10,15: INPUT"Press <ENTER> to return to menu ...";Q$
- DONE:
- RETURN
- '------------------------------------------------------------------- List.All
- LISTALL:
- M$ = MYCALL$ + " - LIST DXCC DATA: ": GOSUB BORDERS: LINE (50,67)-(550,82),3,B
- LOCATE 10,15:INPUT"List to <P>rinter or <S>creen...";Q$
- IF LEFT$(Q$,1)="P" OR LEFT$(Q$,1)="p" THEN PRINTIT
- M$ = "":GOSUB BORDERS
- LOCATE 2,4:PRINT TAB(3)" No. ";TAB(10)" Prefix: ";TAB(27)" Country: ";TAB(57)" Worked: ";TAB(69)" Status:"
- LET X = 1: WK = 0: NC = 0 : RESTORE
- BIGLOOP:
- LOCATE 6,2 : L = 0
- LOOPREAD:
- READ P$,C$
- IF P$ = "END" THEN THATSALL
- IF C=2 THEN GOSUB SHOWLINE : L = L + 1
- IF C=3 AND CS$(X) <> "" THEN GOSUB SHOWLINE : L = L + 1
- IF C=4 AND CS$(X) = "" THEN GOSUB SHOWLINE : L = L + 1
- IF CS$(X) <> "" THEN WK = WK + 1 'stations worked
- IF S$(X) = "?" THEN NC = NC + 1 'stations not confirmed
- X = X + 1
- IF L = 15 THEN GOSUB WAITABIT : LINE (11,38)-(605,180),0,BF :IF A$="M" THEN RETURN :ELSE BIGLOOP
- GOTO LOOPREAD
- THATSALL:
- PRINT " ":PRINT TAB(30)STRING$(45,"=");
- PRINT TAB(30)"Total countries worked ........ ";WK;"/";(X-1)
- PRINT TAB(30)"Total countries confirmed ..... ";WK-NC
- PRINT TAB(30)"Total countries still needed .. ";N-WK
- GOSUB WAITABIT
- RETURN
- PRINTIT:
- GOSUB WIPE:LOCATE 10,15:INPUT"Make sure printer is ready and press <ENTER> ...";Q$
- LET X = 1: WK = 0 : NC = 0 : RESTORE
- OPEN "PRT:" FOR OUTPUT AS #1
- PRINT #1,CHR$(27)"[""1""m"
- PRINT #1,"DXCC Data for: "MYCALL$
- PRINT #1," Dated: "TODAY$
- IF C=2 THEN PRINT #1,"[All DXCC Data:]"
- IF C=3 THEN PRINT #1,"[Countries Worked:]"
- IF C=4 THEN PRINT #1,"[Countries Needed:]"
- PRINT #1,CHR$(27)"[""22""m"
- PRINT #1,CHR$(27)"[""4""w"
- PRINT #1,STRING$(78,"=")
- PRINT #1,TAB(4)"No.";TAB(11)"Prefix:";TAB(30)"Country:";TAB(60)"Worked:";TAB(71)"Status:"
- PRINT #1,STRING$(78,"=")
- LOOPREAD2:
- READ P$,C$
- IF P$ = "END" THEN THATSALL2
- IF C=2 THEN GOSUB PRINTLINE
- IF C=3 AND CS$(X) <> "" THEN GOSUB PRINTLINE
- IF C=4 AND CS$(X) = "" THEN GOSUB PRINTLINE
- IF CS$(X) <> "" THEN WK = WK + 1
- IF S$(X) = "?" THEN NC = NC + 1
- X = X + 1
- GOTO LOOPREAD2
- THATSALL2:
- PRINT #1," ":PRINT #1," ":PRINT #1,STRING$(70,"_")
- PRINT #1,TAB(30)"Total countries worked ........";WK;"/";(X-1)
- PRINT #1,TAB(30)"Total countries confirmed .....";WK-NC
- PRINT #1,TAB(30)"Total countries still needed ..";NC
- PRINT #1,CHR$(27)"[""3""w"
- CLOSE #1
- RETURN
- '----------------------------------------------------------------- List.Stat
- LISTSTAT:
- M$= MYCALL$ + " - DXCC Statistics: ":GOSUB BORDERS
- WK = 0 : NC = 0
- FOR X = 1 TO N
- IF CS$(X) <> "" THEN WK = WK + 1
- IF S$(X) = "?" THEN NC = NC + 1
- NEXT X
- LOCATE 8,15: PRINT "DXCC Data for ";MYCALL$;" dated ";TODAY$;":"
- LOCATE 10,15: PRINT STRING$(60,"="):PRINT
- PRINT TAB(30)"Total countries on file ....";N
- PRINT TAB(30)"Total countries worked .....";WK
- PRINT TAB(30)"Total countries confirmed ..";WK-NC
- PRINT TAB(30)"Countries left to work .....";N-WK
- GOSUB WAITABIT
- RETURN
- '------------------------------------------------------------------- Load.It
- LOADIT:
- LET N = 1 'reset counter to start
- M$= MYCALL$ + " - DXCC Statistics: ":GOSUB BORDERS
- LOCATE 13,20: PRINT"Loading DXCC data from disk:": COLOR 1,0
- OPEN "I",#1,"DXCC.DAT"
- INPUT #1,TODAY$
- WHILE NOT EOF(1)
- INPUT #1,CS$(N) 'callsign worked
- INPUT #1,S$(N) 'status {confirmed?}
- LET N = N + 1
- WEND
- LET N = N - 1 'reset counter
- CLOSE : COLOR 1
- RETURN
- '------------------------------------------------------------------- SAVE.IT
- SAVEIT:
- M$ = MYCALL$ + " - DXCC Statistics: ":GOSUB BORDERS:LINE(50,67)-(550,82),3,B
- IF TODAY$ = "" THEN LOCATE 10,15:PRINT"DANGER!!! No data on file!":GOSUB WAITABIT:RETURN
- LOCATE 10,15: PRINT "Saving DXCC data to disk: ":COLOR 1,0
- OPEN "DF1:DXCC.DAT" FOR OUTPUT AS #1
- PRINT #1,TODAY$
- FOR X = 1 TO N
- PRINT #1,CS$(X) 'callsign worked
- PRINT #1,S$(X) 'status {confirmed}
- NEXT X
- CLOSE #1
- SAVEIT = 1
- RETURN
- '------------------------------------------------------------------ End.It
- ENDIT:
- IF SAVEIT = 1 OR CHANGEDIT = 0 THEN END
- M$ = "END OF PROGRAM":GOSUB BORDERS
- LOCATE 10,15:PRINT"Changes have been made to data since the last Save..."
- GOSUB WAITABIT
- RETURN
- '------------------------------------------------------------------ Get.Date
- GETDATE:
- M$ = "Open a new DXCC file ":GOSUB BORDERS:LINE (50,67)-(550,82),3,B
- LOCATE 10,15: INPUT"What is today's date <07 Feb 87> ";TODAY$
- SET = 1
- RETURN
- '------------------------------------------------------------------ Borders
- BORDERS:
- CLS:LINE (0,0)-(640,5),3,BF : LINE (0,0)-(10,200),3,BF
- LINE (607,0)-(617,200),3,BF : LINE (0,181)-(617,186),3,BF
- LINE (0,30)-(640,35),3,BF : PAINT (20,10),2,3 : PAINT (20,33),1,3
- COLOR 3,2 : LOCATE 3,25: PRINT M$ : COLOR 1,0
- RETURN
- '--------------------------------------------------------------- Show.Line
- SHOWLINE:
- PRINT TAB(3)X;"....";TAB(12)P$;TAB(27)C$;TAB(57)CS$(X);TAB(70)S$(X)
- RETURN
- '--------------------------------------------------------------- Print.Line
- PRINTLINE:
- PRINT#1,X;"....";TAB(13)P$;TAB(27)C$;TAB(57)CS$(X);TAB(70)S$(X)
- RETURN
- '------------------------------------------------------------------- Wipe
- WIPE:
- LOCATE 10,15 : PRINT STRING$(50," ") : RETURN
- '----------------------------------------------------------------- Big.Wipe
- BIGWIPE:
- LOCATE 17,15 : PRINT STRING$(50," ")
- LOCATE 18,15 : PRINT STRING$(50," ") : RETURN
- '--------------------------------------------------------------- Wait.a.Bit
- WAITABIT:
- LOCATE 22,15 : PRINT "Press any key to continue or <M> for Menu ....";
- GOAGAIN:
- A$ = INKEY$ : IF A$ = "" THEN GOAGAIN
- RETURN
- '--------------------------------------------------------- Data.Begins.Here
- '
- DATA A22,BOTSWANA,A3,"TONGA, Republic of",A4X,OMAN,A4,BHUTAN,A6X,UNITED ARAB EMIRATES,A71,QUATAR,A9X,BAHRAIN,AP,PAKISTAN,BV,TAIWAN
- DATA BY,CHINA,C2,"NAURU, Republic of",C3,ANDORRA,C5,THE GAMBIA,C6,BAHAMAS,C9,MOZAMBIQUE,CE,CHILE,KC4,ANTARCTICA,CE0A,EASTER ISLAND
- DATA CE0X,SAN FELIX,CE0Z,JUAN FERNANDEZ,CM-CO,CUBA,CN,MOROCCO,CP,BOLIVIA,CR9,MACAO,CT,PORTUGAL,"CU,CT2",AZORES IS.,CT3,MADEIRA IS.
- DATA CX,URUGUAY,D2-3,ANGOLA,D4,"CAPE VERDE, Republic of",D6,COMOROS,DA-DL,"GERMANY, Fed. Republic of",DU,PHILLIPINES IS.,EA,SPAIN
- DATA EA6,BALEARIC IS.,EA8,CANARY IS.,EA9,CEUTA & MELILLA,EI,IRELAND,EL,LIBERIA,EP,IRAN,ET,ETHOPIA,F,FRANCE,FB8W,CROZET
- DATA "FT8,FB8X",KERGUELEN IS.,FB8Z,AMSTERDAM & ST. PAUL IS.,FC,CORSICA,FG,GUADELOUPE,"FS,FG",SAINT MARTIN,FH,MAYOTTE,FK,NEW CALEDONIA
- DATA FM,MARTINIQUE,FO,CLIPPERTON IS.,FO,FRENCH POLYNESIA,FP,ST. PIERRE & MIQUELON IS.,FR,GLORIOSO IS.,FR,JUAN DE NOVA IS.,FR,REUNION IS.
- DATA FR,TROMELIN IS.,FW,WALLIS & FORTUNA IS.,FY,FRENCH GUIANA,G,ENGLAND,"GD,GT",ISLE OF MAN,GI,NORTHERN IRELAND,"GJ,GC",JERSEY IS.
- DATA GM,SCOTLAND,"GU,GC",GURNSEY IS.,GW,WALES,"H4,VR4",SOLOMON IS.,"HA,HG",HUNGARY,HB,SWITZERLAND,HB0,LICHENSTEIN,HC,ECUADOR
- DATA "HC8,HD8",GALAPAGOS IS.,HH,HAITI,HI,DOMINICAN REPUBLIC,HK,COLOMBIA,HK0,MALPELO,HK0,SAN ANDRES IS.,"HL,HM",KOREA,"HP,H31",PANAMA
- DATA HR,HONDURAS,HS,THAILAND,HV,VATICAN,"HZ,7Z",SAUDI ARABIA,"I,IT",ITALY,IS,SARDINIA,"J2,FL8",DJIBOUTI,"J3,VP2G",GRANADA
- DATA "J5,CR3",GUINEA-BISSAU,"J6,VP2L",ST. LUCIA,"J7,VP2D",DOMINICA,"J88,VP2S",ST. VINCENT & DEPENDENCIES,JA-JO,JAPAN
- DATA "JD,KA1",MINAMI TORISHIMA,"JD,KA1",OGASAWARA,JT,MONGOLIA,JW,SVALBARD,JX,JAN MAYEN IS.,JY,JORDAN,"W,K,N,A",UNITED STATES
- DATA KH1,"BAKER, HOWLAND & PHOENIX IS.","KC4,KP1",NAVASSA IS.,KC6,E. CAROLINES (Micronesia),KC6,W. CAROLINES (Rep of Belau)
- DATA KG4,GUANTANAMO BAY,"KH2,KG6",GUAM,"KH0,KG6",MARIANA IS.,KH6,HAWAII,KH7,KURE IS.,"KH3,KJ",JOHNSTON IS.,KL7,ALASKA,"KH4,KM",MIDWAY IS.
- DATA KP4,PUERTO RICO,"KP2,4,5",DESECHEO IS.,"KH5K,KP6",KINGMAN REEF,"KH5,KP6",PALMYRA & JARVIS IS.,"KH8,KS6",AMERICAN SAMOA
- DATA "KP2,KV",VIRGIN IS.,"KH9,KW",WAKE IS.,KX,MARSHALL IS.,LA-LJ,NORWAY,LU,ARGENTINA,LX,LUXEMBOURG,LZ,BULGARIA,OA,PERU,OD,LEBANON
- DATA OE,AUSTRIA,OH,FINLAND,OH0,ALAND IS.,OJ0,MARKET REEF,OK,CZECHOSLOVAKIA,ON,BELGIUM,"OX,XP",GREENLAND,OY,FAROE IS.,OZ,DENMARK
- DATA P2,PAPUA NEW GUINEA,PA-PI,NETHERLANDS,"PJ,P41,2",NETHERLANDS ANTILLES,"PJ,P47","ST. MAARTEN,SABA, etc.",PY,BRAZIL
- DATA PY0,FERNANDO NORONHA,PY0,ST. PETER & PAUL ROCKS,PY0,TRINIDADE & MARTIN VAZ IS.,PZ,SURINAM,S2,BANGLADESH
- DATA S7,SEYCHELLES IS.,S9,SAO TOME PRINCIPE,SK-SM,SWEDEN,SP,POLAND,"ST,6T1",SUDAN,ST0,SOUTHERN SUDAN
- DATA SU,EGYPT,SV,GREECE,SV,CRETE,SV5,DODECANESE IS.,SV,MOUNT ATHOS,"T2,VR8",TUVALU,"T31,VR1",CENTRAL KIRIBATI
- DATA "T30,VR1",WEST KIRIBATI,"T32,VR3",EAST KIRIBATI,TA,TURKEY,TF,ICELAND,TG,GUATEMALA,TI,COSTA RICA,TI9,COCOS IS.,TJ,CAMAROON
- DATA TL,CENTRAL AFRICAN REPUBLIC,TN,CONGO,TR,GABONESE REPUBLIC,TT,CHAD,TU,IVORY COAST,TY,BENIN,TZ,MALI,"UA,UK,UW,UV",EUROPEAN R.S.F.S.R.
- DATA "UA1,UK1",FRANZ JOSEF LAND,"UA2,UK2F",KALININGRADSK,"UA,UK,UV,UW9-0",ASIATIC R.S.F.S.R.,"UB,UK,UT,UY5",UKRAINE,"UC,UK2A",WHITE R.S.S.R
- DATA "UD6,UK6C,/D/K",AZERBAIJAN,"UF6,UK6F",GEORGIA,"UG6,UK6G",ARMENIA,"UH8,UK8H",TURKOMAN,"UI8,UK8",UZBEK,"UJ8,UK8J,R",TADZHIK
- DATA "UL7,UK7",KAZAKH,"UM8,UK8M/N",KIRGHIZ,"UO5,UK5O",MOLDAVIA,"UP2,UK2B/P",LITHUANIA,"UQ2,UK2G/Q",LATVIA,"UR2,UK2R/T",ESTONIA,"VE,VO,VY",CANADA
- DATA CY0SAB,SABLE IS.,CY9SPI,ST. PAUL IS.,VK,AUSTRALIA,VK,LORD HOWE IS.,VK9,WILLIS IS.,VK9X,CHRISTMAS IS.,VK9Y,COCOS-KEELING IS.
- DATA VK9,MELLISH REEF,VK9N,NORFOLK IS.,VK0,HEARD IS.,VK0,MACQUARIE IS.,"V3A,VP1",BELISE,"V2A,VP2A","ANTIGUA, BARBUDA IS.",VP2E,ANGUILLA
- DATA "V4,VP2K","ST. KITTS, NEVIS IS.",VP2M,MONTSERRAT,VP2V,BRITISH VIRGIN IS.,VP5,"TURKS & CAICOS IS.",VP8,FALKLAND IS.,"VP8,LU-Z",SOUTH GEORGIA IS.
- DATA "VP8,LU-Z",SOUTH ORKNEY IS.,"VP8,LU-Z",SOUTH SANDWICH IS.,"VP8,LU-Z",SOUTH SHETLAND IS.,VP9,BERMUDA IS.,VQ9,CHAGOS IS.,VR6,PITCAIRN IS.
- DATA "V85,VS5",BRUNEI,VS6,HONGKONG,VU,INDIA,VU7,ANDAMAN & NICOBAR IS.,VU7,LACCADIVE IS.,XE,MEXICO,XF4,REVILLA GIGEDO IS.,XT,"BURKINO FASO, Rep. of"
- DATA XU,KHMER REPUBLIC,XV,VIETNAM,XW,LAO PEOPLE'S DEM. REP.,XZ,BURMA,Y1-0,GERMAN DEMOCRATIC REP.,YA,AFGHANISTAN,YB-C,INDONESIA
- DATA YI,IRAQ,YJ,NEW HEBRIDES (Vanatu),YK,SYRIA,"YN,HT",NICARAGUA,YO,ROMANIA,YS,SALVADOR,"YU,YT,YZ",YUGOSLAVIA,YV,VENEZUELA
- DATA YV0,AVES IS.,ZA,ALBANIA,ZB,GIBRALTAR,ZC4,CYPRUS (Sov. Base Area),ZD7,ST. HELENA IS.,ZD8,ASCENSION IS.,ZD9,TRISTAN DE CUNHA IS.
- DATA "Z2,ZE",ZIMBABWE,ZF,CAYMAN IS.,ZK1,SOUTH COOK IS.,ZK3,NORTH COOK IS.,ZK2,NIUE,ZL,NEW ZELAND,ZL9,AUCKLAND & CAMPBELL IS.
- DATA ZL7,CHATHAM IS.,ZL8,KERMANDEC IS.,"ZM7,ZK3",TOKELAUS IS.,ZP,PARAGUAY,"ZS1-6,S88",SOUTH AFRICA & TRANSKEI,ZS2,PRINCE EDWARD IS.
- DATA ZS3,NAMIBIA,1A,S.M.O. KNIGHTS OF MALTA,1S,SPRATLEY IS.,3A,MONACO,"3B6,7",AGELEGA & ST. BRANDON IS.,3B8,MAURITIUS IS.,3B9,RODRIGUEZ IS.
- DATA 3C,EQUATORIAL GUINEA,3C0,ANNOBON IS.,3D2,FIJI IS.,3D6,SWAZILAND,3V,TUNISIA,3X,"GUINEA, Republic of",3Y,BOUVET,4S,SRI LANKA
- DATA 4U1ITU,I.T.U. GENEVA,4U1UN,UNITED NATIONS HQ.,4W,YEMEN,"4X,4Z",ISRAEL,5A,LIBYA,"5B,ZC",CYPRUS,5H,TANZANIA,5N,NIGERIA
- DATA 5R,MALAGASY REPUBLIC,5T,MAURITANIA,5U,NIGER,5V,TOGO,5W,WESTERN SAMOA,5X,UGANDA,5Z,KENYA,"T5,6O",SOMALIA,6W,SENEGAL,6Y,JAMAICA
- DATA 7O,"YEMEN, People's Rep.",7P,LESOTHO,7Q,MALAWI,7X,ALGERIA,8P,BARBADOS,"8Q,VS9",MALDIVE IS.,8R,GUYANA,"T7,9A,M1",SAN MARINO,9G,GHANA
- DATA 9H,MALTA,9J,ZAMBIA,9K,KUWAIT,9L,SIERRA LEONE,9M2,WEST MALAYSIA,"9M6,8",EAST MALAYSIA,9N,NEPAL,9Q,ZAIRE,9U,BURUNDI,9V,SINGAPORE
- DATA 9X,RWANDA,9Y,TRINIDAD & TOBAGO," ","ABU AIL, JABAL AT TAIR"
- DATA END,END
-
-
-