2024年9月21日 星期六

一百個例題 (61 ~ 65)


Ching-Tang Tseng
Hamilton, New Zealand
22 September 2024

第(61)個範例,展示一套為檔案資料加密的方法。

一百個例題包羅萬象,只因為 Forth 有能力做出所有電腦程式語言能夠辦到的事情,我才能夠同樣地寫出各種千奇百怪的範例程式。

程式名稱很簡單,但是程式內容涉及之事比較廣泛,而且,一般初期發展而成的 Forth 系統,都還不具有所有現成可以直接使用的指令來完成此事,所以要寫出這個範例。

加密的方法有很多種,我只找一個最簡單的方法舉例。其他的任何方法,也都必須遵循同樣的處理程序,才能達到將檔案資料加密的目的。所以,仔細看完程式處理步驟是必要的,也才能體會得出將檔案資料加密後的效果、意義與目的。

這一套簡單的加密方法,是單只採用把每一位元組的資料依次取來,與依序取得密碼之單個相應位元組的資料,進行一是一非則得真的XOR邏輯運算,所得結果,重新放回檔案內的同一位置,短的密碼要被循環著使用,完成整個操作後,將檔案回存,就達到加密的目的了。

為了驗證整個效果,我設計了展示指令: test 。執行後,您可以看到檔案原始的內容,再印出加密後顯示的效果,然後再根據同樣的密碼,反解密回去,重新顯示檔案內容,整個效果就全部顯現了。

這麼簡單的原理,想寫成程式,就沒那麼簡單,整個程序則絕對的完整。如果有一天,您學會了另一套加密的方法,想試一試本領,有此範例程式,就會很容易改寫。加密關鍵只在做 XOR 運算,您學會新的加密運算時,也只需要在此處代換掉 XOR 所做之事,就夠了。

一般 Forth 系統內所缺乏的現成指令,從資料結構的宣告開始,就缺乏了,加密、解密所需的密碼,是被儲存在一個必須留存住長度的字串資料結構內的,這個結構必須自己設計,我給的,也只是個典範,它也可以被設計成是一個非常長的檔案,具有長篇大論的文數字,讓人打字都打不出來。我的設計,只採用最長為 80 個字元的方式儲存密碼。

密碼輸入的對談程式: EnterPassword 也是一個必須自己設計的指令,我的展示技巧,在使用一個憑 CR 跳行(13),作為最終限定用字的方法,如此一來,密碼就可以是一句話,中間帶有空格也無所謂的設計格式。

存取檔案的對談程式: EnterFileName 也是一個必須自己設計的指令,通常,檔案的整個名稱,不得帶有空格,因此,使用一個 BL 空格(32),作為輸入時的最終限定用字。 事實上,幾乎現行的 Forth 系統,無論是商售或免費的公益系統,都沒有像我系統中所提供的檔案存取現成指令,此事,前曾討論過,有了他們,這裡才能自由使用。我也已經討論過這一套檔案存取的機制,其中就有 FileType 指令可以直接使用,非常方便。

操作執行 test 前,您得先想好自己的密碼,例如:我就用『i like forth』一句話當密碼。也得先想好將被測試的純文字檔案的全名,例如:假設有一個在資料夾中不太重要的 lnx.txt 純文字檔案可供測試。這樣執行 test 後,您就可以看到所有的結果,操作不慎,毀壞了這個 lnx.txt 檔案,也比較無所謂。也許有一天,您能夠用上它,只是要記得,傳送的雙方都必須要先行知道密碼才行,如果密碼與資料都在一起傳送,那加密就是多餘的了。想搞清楚這套用法的精神,自己先用腦筋想一想整套運作的合理協定應該為何?

這套方法雖簡單,想破解密碼也並不容易,誰能那麼輕易的得知隨便給出的密碼?當然並不容易。設定過密碼的電腦,沒密碼就不好開啟。只有你我才知道的密碼,別人當然也就沒那麼容易解碼,其理在此。
:

 
\ (61)Encrypte.f

\ [---head---][lm|ln|---string---]
: STRING ( lm -- )
  CREATE 1 MAX MAXSTRING MIN DUP C, 0 C, ALLOT   ( lm -- )
  DOES> 1+ COUNT ;                               ( -- addr ln )

: S! ( addr1 cnt1 addr2 cnt2 -- )
  DROP DUP 2 - C@
  ROT MIN >R DUP 1- R@ SWAP C! R> CMOVE ;

80 STRING FILEPASSWORD

\ password build here
\ Usage: S" CTT20160310" FILEPASSWORD S!
: EnterPassword ( -- )
  CR ." Enter encrypte password : "
  CR QUERY 13 WORD COUNT FILEPASSWORD S! ;

: EnterFileName ( -- )
  CR ." Enter file name : "
  CR QUERY BL WORD COUNT GET-FILE
;

: FILEENCRYPTE ( -- )
  FLEN 0
  DO
  I FADR + C@
  I    FILEPASSWORD NIP MOD    FILEPASSWORD DROP + C@
  XOR
  I FADR + C!
  LOOP ;

: test ( -- )
  EnterPassword
  EnterFileName
  CR CR FILETYPE
  FILEENCRYPTE
  CR CR FILETYPE
  FILEENCRYPTE
  CR CR FILETYPE
;

第(62)個範例,是一個獨特的整數函數設計。

我一直在研究數學運算系統的學問,搞了四十幾年,心中難免就積聚了許多類比的數學觀念,每當在常用的實數數學體系中,實現各種常用函數的設計時,我就會問自己,別的數學體系中有沒有?或需不需要也有等效的函數?自問的效果,絕對是正面的,身體力行,再去實踐之後,我就能發現更為深入的道理。我也隨時提醒自己,這些東西都很有用處,不要浪費掉這些辛苦研究出來的成果。這個整數體系內以 2 為底的對數函數,就是這麼來的。

函數都有反函數,設計出來的整數函數,當然也就可以有整數的反函數, Log2 通常可以寫成 logb , ALog2 則為 alogb ,但我在後來的設計中,不再使用這樣的名稱,改為 nlb 的用名了,以強化表示,它是只適用於整數體系環境內的對數函數。相應的其他函數,也因為同樣的類推而產生出來,例如: nlg 為以 10 為底的整數對數函數。我不擬談得太多,範例中也不打算把所有的相關函數設計全都包括進來,那樣做,就會把範例程式搞得非常凌亂,失去了中心要義。

我熟悉數學函數的設計方法,往上、往下延伸研究時,會發現這些東西,都有其連貫性。也就是說,往上,我在自行設計出實數的整套對數函數群時,所有的成果,也都是根基於這個以 2 為底的整數對數函數來設計的。往下,我拜讀過不少硬體數學運算處理器的論文,發現那些能提供對數函數的硬體元件,根本也是基於先有以 2 為底的對數單元,才組合出後來常用的以自然對數 e 為底與以 10 為底所有的其他對數函數。更甚的是,請注意我在 Log2 中的設計,它也是只靠一個向右移位的移位器(rshift)就能設計出來的程式。

研究這樣的軟體程式,是想自行設計製造硬體元件的基礎,但是,中國人還無能設計好用的數學運算處理器(coprocessors)。我們的系統環境從 32 位元進入 64 位元後,系統硬體內的這個元件,並沒有因為位元基礎量翻倍而跟著翻倍,也就是, 32 位元系統中使用 80 位元的 coprocessor , 64 位元環境中,沒有全面改裝 160 位元的 coprocessor ,而仍是 80 位元的結構。我看過 iForth 系統設計者貼文說過,有這種 160 位元的 coprocessors ,加裝一片要價 250 歐元。中國人將來想不想搞出自己的 coprocessors? 沒有類似這個範例程式的研究、設計、與應用,那就難成。

整數對數函數的實際應用,也不僅只是上列的討論而已,我在設計系統時,免不了要為最終成果修邊剪枝,讓函數的最終值能適用於真實環境,就會產生該如何處理最後一位不準位數的問題,怎麼辦?好的系統就有所謂的捨位與截項(round off and truncate)技術應用。請注意!這些技術不單只是講演算式子的截項方法而已,還包括了該如何四捨五入與棄除位數的數字處理。做這些美化成果的工作時,不是見到數字就直接處理這麼簡單,要顧及位數。那麼,取得位數的最快方法,就是利用這個範例中的整數對數函數,我設計的系統中,幾乎所有的常用函數提供最終結果前,都用到這樣的設計。其他的應用,就不多說了。

關於我設計之系統中的各種常用數學函數,在我的個人網頁一篇文章中有具體的圖形展示,文章是 20190216 貼出的:『測試函數』,那裡也談到上述細節中的問題,顯示了我如何好好地把這些研究設計發揮出痛快效果的歷史記錄。
:

 
\ (62)Log2.f

\ Lb(n) = Log2(n) , Lb(8)=3  means 8=2^3
\ ALb(n)= ALog2(n) = 2^n , ALb(3)=8 means 2^3=8

: Log2     ( n -- Log2[n] )
  -1 SWAP
  BEGIN
     ?DUP
  WHILE
     SWAP 1+ SWAP
     1 RSHIFT
  REPEAT
;

: ALog2    ( n -- 2^n )
  1 SWAP 0
  ?DO 2 * LOOP ;

第(63)個範例是一個把字串內容反向印出來的優質程式。

字串處理在 Forth 領域,算是比較複雜一點、屬於二級難度的問題。我在長期使用 Forth 的歷史中,卻經常會碰到有此需求,必須把字串反向印出來。在第(25)個範例中,就曾用到這種技術,但是在那個範例中,我仍然設計了將字串反轉過來的操作指令叫作 turn 。現在這個範例,就能解決不反轉字串,直接反向印出字串的結果,所以我稱它是優質程式,特予收集。

程式的原作者是個住在加州附近的美國朋友,國際論壇上的署名是 Hugh ,網上發言非常彪悍,長期力戰群雄,毫不退縮,大家都對他不好,也很感冒,他卻對我很好,每次寫信給我時,都恭恭敬敬地問問題,包括問中國人的文化。若不論性格, Hugh 有許多可取之處,他在公開場合,大方貢獻出不少漂亮的設計,尤其是字串處理方面的成就,非常優秀。我在個人網頁的貼文中,凡是用到他的設計,必指名道謝,大概也是因為這樣,他才非常尊重我。

Hugh 的專長,本是為數位機械設計計算尺(slide ruler)式的顯示尺,後來,全美工作母機的生產事業崩潰後,他就沒有再做此工作,改為替別人寫 Forth metacompiler 的職業,那時, Forth 最著名的期刊:四度空間(FORTH DIMENSIONS)出版到第 19 年最後一冊,在最後一期內,還可以看得到 Hugh 貢獻出來的文章。所以他也算是 Forth 界的老手了,我一直以禮相待,尊重他。他後來的成就,是專注於具有字串堆疊的 Forth 系統設計,他擁有自己獨創的 novice Forth 系統,把所有的基本指令都設計成專搞字串,所以指令都是以 $ 符號開頭,如: $DUP , $DROP , $SWAP ..... 之類的用法。許多專家對 List 式的資料結構操控能力,沒他熟悉。

他在 XP 時代送過我他所創作之系統的源程式,我則回敬他用組合語言寫成之叫用 coprocessor 完成工作的浮點系統源程式,並指導他利用免費的 MVP Forth 系統,反組譯出指令內容的使用技巧。後來,他在國際論壇上,經常憑此方法與群雄論劍,直到 64 位元普及之後,那套方法解不出 64 位元的碼了,他才停手。

後來的聯繫,都是他為了請教數學問題而來信,由於他只上過高中,我們能談的事情就無法深入。超出高中程度的問題,則是他代替他大學畢業的哥哥向我請教的問題,我都好好的答覆,等到大家都退休了,來信也就少了。

我收集他所貢獻的程式,當然應該清楚交代我跟他交往的事情,表示尊重。以後想再對他有所要求,他才會誠懇對待,我確信,我若開口向他再要 novice Forth 最新版的源程式,他一定會給我,但我若無法深入參與共同研發,最好別去打擾,留著他當一輩子的朋友,就像我現在與大家交往的情誼一樣。

我在研究首個 64 位元 Forth 系統時,使用純用 C 寫成之模擬式的 Sod64 Forth 系統,因為那時還沒有公益性的 64 位元 Forth 系統可用,只有這一套。但因它係以 C 在 32 位元環境中模擬 64 位元設計而成,全世界都沒有人對它有興趣,我只好自己精研。我在其中加設計浮點系統時,才發現系統將待印出的數字都擺在 PAD 以下,向 HERE 的方向成長,反正沒有 256 個數字的東西要印出來,碰不到 HERE 點,不會破壞系統,這樣擺就無所謂。可是,對我的發展影響很大,每個數字都得反過來印出,不先反轉就不能直接使用 type 指令,還真是不好處裡,為了這事,我苦惱了很久,如果那時就有 Hugh 公開捐贈的這個 backtype 程式,問題就很容易解決了,但這個程式是後來才取得的。別篇網文中也曾提及這個 backtype 指令的應用,這個範例則詳述了他的來源。

我在設計無限位數的除法設計時,也碰到除得的商數,是一個一個依序擺進字串的,想印出結果時,就得反過來印,就得使用這個 Hugh 的貢獻,才會方便,後面的範例中也許會再論及這套技術。請注意,他沒有把字串先翻轉過來後才印,是就地處理,設計方式算得上是比較高明。
:

 
\ (63)BackType.f

\ 20160314 Hugh Aquilar posted on c.l.f.

: backtype ( adr cnt -- )
    over +  1- 
    2dup u<
    if
        do  I c@ emit  -1 +loop 
    else 
        2drop
    then ;

: $>pad ( adr cnt -- )
  dup pad c!
  pad 1+ swap cmove ;

s" this is a test." $>pad
cr cr pad count type
cr cr pad count backtype

第(64)範例是一個 Forth 的特殊應用程式,讓電腦操控喇叭,演出單音音樂。

以前的個人電腦,可以自行將控制值放進指定記憶體內,直接驅動喇叭,演出音樂。後來的個人電腦,只能透過作業系統提供的功能程式來驅動喇叭。前者有它的方便性,後者有它的多樣性。我們在這個範例中,只利用一個很單純的功能,只提供頻率與震盪時間長度來發出聲音,效果當然不會很好,但是能告訴大家,軟體系統是如何辦到這些控制硬體之事的,也就是說能夠告訴您,這種程式該如何設計?

完美可叫用的音效功能程式,還可以包括波譜的選擇,便能模擬出各種樂器的聲音,甚至於可以模擬出名聲樂家的話語,還能調聲調高低,令其唱歌,清唱也行,唱歌劇也行。現在這個範例,只是最基礎、最初步的發聲方法,但,再複雜的功效,程式也得照同樣的方法來設計,才能達到目的。我也沒有增加能夠配合作業系統同時演出兩個檔案程式的設計,來辦到能像交響樂那樣演出的效果。這樣的設計,我也能夠辦得到,只是需要花費很多時間,卻與數學計算無關。

發聲的整個關鍵在給音長與頻率兩個參數,在 Win32Forth 系統中有內建的 Beep 指令可以叫用,在 Wina32 Forth 系統中,以及在 FasmForth 系統中,也都可以先連結起作業系統中的動態連結程式(.dll)後,再叫用其中指定名稱的指令,來達到目的。另外兩個附屬的 (64-1) , (64-2) 範例,只展示它們的叫用方法,編寫音調程式的部份則不列出。所有 Forth 系統叫用作業系統功能程式的設計原理,都完全一樣,搞通這個範例,就能放諸四海而皆準。

實際上,好的音樂程式,沒這麼單純,但要設計得好,就得在音樂的樂理上有點素養,我有比較完整的設計,並將成果貼文於我的個人網頁,而且全用英文寫成的文章,文內附貼我自己使用那一套卡拉 OK 式的程式,唱出『茉莉花』中文歌的短片錄影。

該文有許多音樂方面的特色,單憑兩個參數,能調整出任意的音調與速度,曲譜是我自創的文字譜,曲調也可以隨我自己的聲調來調整,速度板拍的宣告,就用音樂專用的術語來表示,整套音樂功能盡量類似於五線譜的樂譜表達方式,文字譜則選用『首調』唱法,而不用『固定調』唱法來寫文字譜。樂理,我只點到為止,我略懂。

歐洲及俄國人擅長把音樂搞成全國普及的程度,所以他們參訪該網文的數目很多,看完後,也在國際論壇網頁上推介。因為他們知道,那才是比較接近正規音樂的程式設計方式。程式的內容比較大,不宜當範例教材,大家若有興趣聽我真人實唱,請自行前往參考。該篇文章可以永遠留在網上,也就是本人唱歌的聲音,可以遍傳全世界許多年,這樣做比較有意義。
:

 
\ (64)tone.f

\ 20160402
\ 192 = 2*3*4*8

192 3 * VALUE Duration
\ n1:Duration   n2:Tone Frequency
: sing ( n1 n2 -- ) CALL Beep drop ;
: silence ( n1 -- ) MS ;
: | ; immediate

\ Get duration ( -- n1 )
: 4T   Duration 4 * ;
: 3T   Duration 3 * ;
: 2T   Duration 2 * ;
: 1T   Duration     ;
: T/2  Duration 2 / ;
: T/3  Duration 3 / ;
: T/4  Duration 4 / ;
: T/8  Duration 8 / ;
: T/16 Duration 16 / ;

\ Get tone frequency ( -- n2 )
: MDO 523 ;
: MRE 587 ;
: MMI 659 ;
: MFA 698 ;
: MSO 784 ;
: MLA 880 ;
: MSI 988 ;

\ Sing it ( n1 -- )
: Dl MDo sing ;   : LDo MDo 2 / sing ;   : HDo MDo 2 * sing ;
: Re MRe sing ;   : LRe MRe 2 / sing ;   : HRe MRe 2 * sing ;
: Mi MMi sing ;   : LMi MMi 2 / sing ;   : HMi MMi 2 * sing ;
: Fa MFa sing ;   : LFa MFa 2 / sing ;   : HFa MFa 2 * sing ;
: So MSo sing ;   : LSo MSo 2 / sing ;   : HSo MSo 2 * sing ;
: La MLa sing ;   : LLa MLa 2 / sing ;   : HLa MLa 2 * sing ;
: Si MSi sing ;   : LSi MSi 2 / sing ;   : HSi MSi 2 * sing ;

: Waltzing-Matilda
   1T SO   T/2 SO  T/2 SO  1T SO   1T MI
   1T HDO  T/2 HDO T/2 SI  1T LA   1T SO
   1T SO   T/2 SO  T/2 SO  1T LA   1T SO
   1T SO   T/2 FA  T/2 MI  1T RE
   T/2 Dl T/2 RE  1T MI   1T MI   1T RE  1T RE
   T/2 Dl T/2 RE  T/2 MI T/2 Dl  T/2 LLA T/2 LSI  1T Dl
   1T LSO  T/2 Dl T/2 MI  1T SO   T/2 FA T/2 MI
   1T RE   T/2 RE  T/2 RE  1T Dl  ;
: Jasmine
  1T MI T/2 MI T/2 SO T/2 LA T/2 HDO T/2 HDO T/2 LA 1T SO T/2 SO T/2 LA 2T SO
  1T MI T/2 MI T/2 SO T/2 LA T/2 HDO T/2 HDO T/2 LA 1T SO T/2 SO T/2 LA 2T SO
  1T SO 1T SO 1T SO T/2 MI T/2 SO 1T LA 1T LA 2T SO
  1T MI T/2 RE T/2 MI 1T SO T/2 MI T/2 RE 1T Dl T/2 Dl T/2 RE 2T Dl
  T/2 MI T/2 RE T/2 Dl T/2 MI 1T T/2 + RE T/2 MI 1T SO T/2 LA T/2 HDO 2T SO
  1T RE T/2 MI T/2 SO T/2 RE T/2 MI T/2 Dl T/2 LLA 2T LSO
  1T LLA 1T Dl 1T T/2 + RE T/2 MI T/2 Dl T/2 RE T/2 Dl T/2 LLA 2T LSO ;
: I-am-a-little-bird
  1T DL 1T DL 1T DL 1T T/2 + MI T/2 RE 1T DL
  1T MI 1T MI 1T MI 1T T/2 + SO T/2 FA 1T MI
  1T SO 1T FA 1T MI 3T RE
  2T RE T/2 DL T/2 SI 1T DL 1T RE 1T MI
  2T FA T/2 MI T/2 RE 1T MI 1T FA 1T SO
  T/2 SO T/2 FA 1T MI 1T RE 2T DL ;
: Pocalicalina
  1T SO T/2 HMI T/2 HMI T/2 HRE T/2 HRE 2T HDO 3T HMI
;

: TEST 1 0
  DO
  Waltzing-Matilda 2T silence
  Pocalicalina 2T silence
  Jasmine 2T silence
  I-am-a-little-bird 2T silence
  LOOP ;

\s
The following table shows the relationship of notes and their frequencies
in one octave.
_______________________________________________________
C       D       E       F       G       A       B
Dl      Re      Mi      Fa      So      La      Si
261.63  293.66  329.63  349.23  392.00  440.00  493.88
523.25  587.33  659.26  698.46  783.99  880.00  987.77
-------------------------------------------------------

By doubling or halving the frequence, the coinciding note values can be
estimated for the preceding and following octaves.

\ (64-1)play music in wina forth

: Z ( sc -- adr)
  0 , DROP ;                                    
                                                  
: make-constant ( n adr -- )                                                
  BODY> >R    
  R@ >DFA  !   
  'BL >CFA @   
  R> >CFA ! ;           
                                                   
: LOAD-DLL: ( sc -- u ) 
  CREATE $, DROP 
  DOES>  DUP >R $@  LOAD-DLL           
         DUP R> make-constant ;                                     
                                               
: DLL-ADDRESS:  ( sc xt -- adr ) 
  CREATE , $, DROP     
  DOES>  DUP >R   CELL+ $@  
         R@ @ EXECUTE DLL-ADDRESS   
         DUP R> make-constant ;          

"kernel32.dll" LOAD-DLL: K32 
"Beep" 'k32 DLL-ADDRESS: BBB
: sing ( time frequency -- )
  BBB call drop ;

\ (64-2)FasmForth64Tone.F
\ REQUIRE API_2: lib\WAPI.4
\ REQUIRE API_2: WAPI.4

: DLL_CREATE CREATE  PARSE-NAME FILE-BUFF ASCII-Z DLL_S
  DUP 0= ABORT" api unavailable" , ;

: API_0: DLL_CREATE DOES> @ API_0 ;
: API_1: DLL_CREATE DOES> @ API_1 NIP ;
: API_2: DLL_CREATE DOES> @ API_2 NIP NIP ;
: API_3: DLL_CREATE DOES> @ API_3 NIP NIP NIP ;
: API_4: DLL_CREATE DOES> @ API_4 NIP NIP NIP NIP ;
: API_5: DLL_CREATE DOES> @ API_5 NIP NIP NIP NIP NIP ;

\ CR .( LIB LOAD=)  S" KERNEL32.DLL" DROP DLL_L DUP H.
\ DUP 0= [IF] .( KERNEL32.DLL LOAD ERROR) ABORT [THEN]

S" KERNEL32.DLL" DROP DLL_L
CONSTANT KERNEL32DLL
 
\ Get API Beep
KERNEL32DLL API_2: Beep Beep
: sing ( duration freqency -- )
  Beep DROP ;

第(65)個範例程式,能像發送摩爾斯(Morse)電碼一樣,產生出發送電報時的聲音。

這個程式的原始碼,可以追溯到 1980 年代。早期 IBM XT 個人電腦時代,在 Poly Forth 系統中就附贈這樣的 Demo 程式。

它的源程式就是附隨在這個範例程式最前面的部份,但已不能執行,因為源程式中使用了 pc! 這個指令,那是對 isolated I/O 記憶體進行直接操控時所使用的指令,在視窗軟體環境中,對執行軟體進行了所謂保護模式狀態下才能工作的限制,就不能再使用這種指令了。

為了驗證 W10 還能工作於此範例,我特地仔細測試了一下,才發現,當初,我是為了測試 Wina32 系統而使用此例發展程式,不是為了 Win32Forth 系統而改寫的範例。但沒有關係,只需在編寫 Morse 電碼程式的前面,插入一段擷取來自 Wina32 的設計,重新載入程式就能執行了。令電腦發出聲音的方法與前一(64)範例相同,也是叫用系統已有的 Beep 功能程式而實現的,所需的 dit , dah 兩個聲音,由頻率決定。

從最古老的設計,推進到最現代的環境,我一直沒有中斷過使用 Forth ,所以熟知問題所在。現在,回頭去介紹古老 8086 CPU 的工作機制,是沒有必要的事情。若要仔細談起來,這種搞電腦對外控制的技術,還有像 6502 CPU 那樣的 memory map I/O 的學問要談,會越扯越多。這些東西我都熟,在以 Forth 為主之軟硬體對應關係上的發展技術,因為我追用時間很長、又未曾中斷過使用 Forth 的關係,還算熟悉,能夠快速的改出程式。

能適用於 W10 作業系統的這個範例,整個程式修正如下:
:

 
: tone ( time frequency -- )
  CALL Beep drop ;

\ morse demonstation begins here 
880 constant freq    \ 440 --> 880,         value --> constant
 45 constant adit    \ 1 dit will be 45 ms, value --> constant 

: ns 4 * ;           \ convert adit to duration value, without nano second meaning

: dit_dur     adit ns ; 
: dah_dur     adit 3 * ns ; 
: wordgap     adit 5 * ns ;
: off_dur     adit 2/ ns ; 
: lettergap   dah_dur ; 

: sound   ( duration -- )   freq tone ;
: silence ( duration -- )      0 tone ;

: MORSE-EMIT  ( char -- )               \ send morse and echo to console 
        dup  bl =    \ bl = blank = 32
        if 
             wordgap   silence drop 
        else 
             PAD C!                     \ write char to buffer 
             PAD 1 EVALUATE             \ evaluate 1 character 
             lettergap silence          \ pause for correct sounding morse code
        then ; 

: BOUNDS ( ADDR LEN -- Last Init )
  OVER + SWAP ;

: TRANSMIT ( ADDR LEN -- ) 
           CR                          \ newline, 
           BOUNDS                      \ convert loop indices to address ranges 
           DO 
              I C@ dup emit            \ dup and send char to console 
              MORSE-EMIT               \ send the morse code
           LOOP ;

: .   ( -- ) dit_dur sound  off_dur silence ;
: -   ( -- ) dah_dur sound  off_dur silence ;


\ define morse letters as Forth words. They transmit when executed 

: A  . -  ;     : B  - . . . ;   : C  - . - . ;    : D  - . . ; 
: E  . ;        : F  . . - . ;   : G  - - . ;      : H  . . . . ; 
: I  . . ;      : J  . - - - ;   : K  . - . ;      : L  . - . . ; 
: M - - ;       : N  - . ;       : O  - - - ;      : P  . - - . ; 
: Q  - - . - ;  : R  . - . ;     : S  . . . ;      : T  - ; 
: U  . . - ;    : V  . . . - ;   : W  . - - ;      : X  - . . - ; 
: Y  - . - - ;  : Z  - - . . ; 

: 0  - - - - - ;     : 1  . - - - - ; 
: 2  . . - - - ;     : 3  . . . - - ; 
: 4  . . . . - ;     : 5  . . . . . ; 
: 6  - . . . . ;     : 7  - - . . . ; 
: 8  - - - . . ;     : 9  - - - - . ; 

: '  - . . - . ;     : \  . - - - . ;    : !  . - . - . ; 

: ?  . . - - . . ; 
: ,  - - . . - - ; 
: /  . . . - . - ;  ( SK means end of transmission in int'l Morse code) 
: .  . - . - . - ; 

S" CQ CQ CQ DE VE3CFW VE3CFW / " TRANSMIT

沒有留言: